X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=db-odbc%2Fodbc-api.lisp;h=e51f2483b1c4cebc026651dff63ae2d4858bc507;hp=a15d628f8c3c82120ed7cbf7e91f00ba5f6465b2;hb=9bbed78051e80e6ab76ae47834136035602bbbf1;hpb=d107be8f0cad113b96b6cfe443cc4d7c08126db4 diff --git a/db-odbc/odbc-api.lisp b/db-odbc/odbc-api.lisp index a15d628..e51f248 100644 --- a/db-odbc/odbc-api.lisp +++ b/db-odbc/odbc-api.lisp @@ -24,11 +24,16 @@ May be locally bound to something else if a certain type is necessary.") (defvar *binary-format* :unsigned-byte-vector) -(defvar *time-conversion-function* (lambda (universal-time &optional fraction) - (declare (ignore fraction)) - universal-time) +(defvar *time-conversion-function* + (lambda (universal-time &optional fraction) + (declare (ignore fraction)) + (clsql-base:format-time + nil (clsql-base:utime->time universal-time) + :format :iso) + #+ignore + universal-time) "Bound to a function that converts from a Lisp universal time fixnum (and a fractional -as possible second argument) to the desired representation of date/time/timestamp.") +as possible second argument) to the desired representation of date/time/timestamp. By default, returns an iso-timestring.") (defvar +null-ptr+ (make-null-pointer :byte)) (defparameter +null-handle-ptr+ (make-null-pointer :void)) @@ -108,11 +113,11 @@ as possible second argument) to the desired representation of date/time/timestam (progn ,result-code ,@body)) (#.$SQL_INVALID_HANDLE (error - 'clsql-base-sys:clsql-odbc-error + 'clsql-base:clsql-odbc-error :odbc-message "Invalid handle")) (#.$SQL_STILL_EXECUTING (error - 'clsql-base-sys:clsql-odbc-error + 'clsql-base:clsql-odbc-error :odbc-message "Still executing")) (#.$SQL_ERROR (multiple-value-bind (error-message sql-state) @@ -120,7 +125,7 @@ as possible second argument) to the desired representation of date/time/timestam (or ,hdbc +null-handle-ptr+) (or ,hstmt +null-handle-ptr+)) (error - 'clsql-base-sys:clsql-odbc-error + 'clsql-base:clsql-odbc-error :odbc-message error-message :sql-state sql-state))) (otherwise @@ -686,7 +691,7 @@ as possible second argument) to the desired representation of date/time/timestam (#.$SQL_C_FLOAT (uffi:allocate-foreign-object :float)) (#.$SQL_C_DOUBLE (uffi:allocate-foreign-object :double)) (#.$SQL_C_BIT (uffi:allocate-foreign-object :byte)) - (#.$SQL_C_STINYINT (uffi:allocate-foreign-object :short)) + (#.$SQL_C_STINYINT (uffi:allocate-foreign-object :byte)) (#.$SQL_C_SSHORT (uffi:allocate-foreign-object :short)) (#.$SQL_C_CHAR (uffi:allocate-foreign-string (1+ size))) (#.$SQL_C_BINARY (uffi:allocate-foreign-string (1+ (* 2 size)))) @@ -939,3 +944,46 @@ as possible second argument) to the desired representation of date/time/timestam (defun %list-tables (hstmt) (with-error-handling (:hstmt hstmt) (SQLTables hstmt +null-ptr+ 0 +null-ptr+ 0 +null-ptr+ 0 +null-ptr+ 0))) + +(defun %table-statistics (table hstmt &key unique (ensure t)) + (with-cstrings ((table-cs table)) + (with-error-handling (:hstmt hstmt) + (SQLStatistics + hstmt + +null-ptr+ 0 + +null-ptr+ 0 + table-cs $SQL_NTS + (if unique $SQL_INDEX_UNIQUE $SQL_INDEX_ALL) + (if ensure $SQL_ENSURE $SQL_QUICK))))) + +(defun %list-data-sources (henv) + (let ((dsn (allocate-foreign-string (1+ $SQL_MAX_DSN_LENGTH))) + (desc (allocate-foreign-string 256)) + (results nil)) + (unwind-protect + (with-foreign-objects ((dsn-len :short) + (desc-len :short)) + (let ((res (with-error-handling (:henv henv) + (SQLDataSources henv $SQL_FETCH_FIRST dsn + (1+ $SQL_MAX_DSN_LENGTH) + dsn-len desc 256 desc-len)))) + (when (or (eql res $SQL_SUCCESS) + (eql res $SQL_SUCCESS_WITH_INFO)) + (push (convert-from-foreign-string dsn) results)) + + (do ((res (with-error-handling (:henv henv) + (SQLDataSources henv $SQL_FETCH_NEXT dsn + (1+ $SQL_MAX_DSN_LENGTH) + dsn-len desc 256 desc-len)) + (with-error-handling (:henv henv) + (SQLDataSources henv $SQL_FETCH_NEXT dsn + (1+ $SQL_MAX_DSN_LENGTH) + dsn-len desc 256 desc-len)))) + ((not (or (eql res $SQL_SUCCESS) + (eql res $SQL_SUCCESS_WITH_INFO)))) + (push (convert-from-foreign-string dsn) results)))) + (progn + (free-foreign-object dsn) + (free-foreign-object desc))) + (nreverse results))) +