X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=db-odbc%2Fodbc-api.lisp;h=9ebdb3e6e506475104869f55624219851192b0e8;hb=78aaea5ba2c007294616ca014849027dd3b875e8;hp=5d2acf964e88c5b1c25b60a3d2e984e18de3bced;hpb=d93955e3f6ad71eb27f334c50f997b4d351724c3;p=clsql.git diff --git a/db-odbc/odbc-api.lisp b/db-odbc/odbc-api.lisp index 5d2acf9..9ebdb3e 100644 --- a/db-odbc/odbc-api.lisp +++ b/db-odbc/odbc-api.lisp @@ -22,17 +22,12 @@ 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) - (let ((time (clsql-sys:utime->time universal-time))) - (setf time (clsql-sys:time+ - time - (clsql-sys:make-duration :usec (/ fraction 1000)))) - (clsql-sys:format-time nil 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. By default, returns an iso-timestring.") +(defvar *time-format* + (lambda (time) + (clsql-sys:format-time nil time :format :iso)) + "Bound to a function that converts from a clsql:wall-time 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)) @@ -56,8 +51,15 @@ as possible second argument) to the desired representation of date/time/timestam (defun %cstring-into-vector (ptr vector offset size-in-bytes) (dotimes (i size-in-bytes) (setf (schar vector offset) - (ensure-char-character - (deref-array ptr '(:array :unsigned-char) i))) + (ensure-char-character + ;; this is MUCH faster than (sb-alien:deref ptr i) even though + ;; sb-alien:deref makes more sense. I snagged this by looking at + ;; cffi which we had used previously without this bug + #+(and sbcl (not cffi)) + (sb-sys:sap-ref-8 (sb-alien:alien-sap ptr) i) + #-(and sbcl (not cffi)) + (deref-array ptr '(:array :unsigned-char) i) + )) (incf offset)) offset) @@ -579,8 +581,9 @@ as possible second argument) to the desired representation of date/time/timestam (defun sql-to-c-type (sql-type) (ecase sql-type + ;; Added -10 for MSSQL ntext type and -11 for nvarchar ((#.$SQL_CHAR #.$SQL_VARCHAR #.$SQL_LONGVARCHAR - #.$SQL_NUMERIC #.$SQL_DECIMAL -8 -9 -10) $SQL_C_CHAR) ;; Added -10 for MSSQL ntext type + #.$SQL_NUMERIC #.$sql_decimal -8 -9 -10 -11) $SQL_C_CHAR) (#.$SQL_INTEGER $SQL_C_SLONG) (#.$SQL_BIGINT $SQL_C_SBIGINT) (#.$SQL_SMALLINT $SQL_C_SSHORT) @@ -660,10 +663,9 @@ as possible second argument) to the desired representation of date/time/timestam (defun read-data (data-ptr c-type sql-type out-len-ptr result-type) (declare (type long-ptr-type out-len-ptr)) - (let* ((out-len (deref-pointer out-len-ptr #.$ODBC-LONG-TYPE)) + (let* ((out-len (get-cast-long out-len-ptr)) (value - (cond ((= out-len $SQL_NULL_DATA) - *null*) + (cond ((= out-len $SQL_NULL_DATA) *null*) (t (case sql-type ;; SQL extended datatypes @@ -673,20 +675,21 @@ as possible second argument) to the desired representation of date/time/timestam (#.$SQL_SMALLINT (get-cast-short data-ptr)) ;; ?? (#.$SQL_INTEGER (get-cast-int data-ptr)) (#.$SQL_BIGINT (get-cast-big data-ptr)) - (#.$SQL_DECIMAL - (let ((*read-base* 10)) - (read-from-string (get-cast-foreign-string data-ptr)))) + ;; TODO: Change this to read in rationals instead of doubles + ((#.$SQL_DECIMAL #.$SQL_NUMERIC) + (let* ((*read-base* 10) + (*read-default-float-format* 'double-float) + (str (get-cast-foreign-string data-ptr))) + (read-from-string str))) (#.$SQL_BIT (get-cast-byte data-ptr)) (t (case c-type ((#.$SQL_C_DATE #.$SQL_C_TYPE_DATE) - (funcall *time-conversion-function* (date-to-universal-time data-ptr))) + (funcall *time-format* (date-to-clsql-time data-ptr))) ((#.$SQL_C_TIME #.$SQL_C_TYPE_TIME) - (multiple-value-bind (universal-time frac) (time-to-universal-time data-ptr) - (funcall *time-conversion-function* universal-time frac))) + (funcall *time-format* (time-to-clsql-time data-ptr))) ((#.$SQL_C_TIMESTAMP #.$SQL_C_TYPE_TIMESTAMP) - (multiple-value-bind (universal-time frac) (timestamp-to-universal-time data-ptr) - (funcall *time-conversion-function* universal-time frac))) + (funcall *time-format* (timestamp-to-clsql-time data-ptr))) (#.$SQL_INTEGER (get-cast-int data-ptr)) (#.$SQL_C_FLOAT @@ -702,8 +705,7 @@ as possible second argument) to the desired representation of date/time/timestam (get-cast-binary data-ptr out-len *binary-format*)) ((#.$SQL_C_SSHORT #.$SQL_C_STINYINT) ; LMH short ints (get-cast-short data-ptr)) ; LMH - (#.$SQL_C_SBIGINT (uffi:allocate-foreign-object #.$ODBC-BIG-TYPE) - (get-cast-short data-ptr)) + (#.$SQL_C_SBIGINT (get-cast-big data-ptr)) #+ignore (#.$SQL_C_CHAR (code-char (get-cast-short data-ptr))) @@ -875,13 +877,14 @@ as possible second argument) to the desired representation of date/time/timestam (defconstant $sql-data-truncated (intern "01004" :keyword)) + (defun read-data-in-chunks (hstmt column-nr data-ptr c-type sql-type out-len-ptr result-type) (declare (type long-ptr-type out-len-ptr) (ignore result-type)) (let* ((res (%sql-get-data hstmt column-nr c-type data-ptr +max-precision+ out-len-ptr)) - (out-len (deref-pointer out-len-ptr #.$ODBC-LONG-TYPE)) + (out-len (get-cast-long out-len-ptr)) (offset 0) (result (case out-len (#.$SQL_NULL_DATA @@ -907,44 +910,47 @@ as possible second argument) to the desired representation of date/time/timestam (let ((*read-base* 10)) (read-from-string str)) str))) - (otherwise - (let ((str) - (offset 0) - (octets (make-array out-len :element-type '(unsigned-byte 8) :initial-element 0))) + (otherwise + (let ((str (make-string out-len))) (loop - do - (loop for i from 0 to (1- (min out-len +max-precision+)) - do (setf (aref octets (+ offset i)) (deref-array data-ptr '(:array :unsigned-byte) i)) - finally (incf offset (1- i))) - while - (and (= res $SQL_SUCCESS_WITH_INFO) - (> out-len +max-precision+)) - do - (setf res (%sql-get-data hstmt column-nr c-type data-ptr +max-precision+ out-len-ptr) - out-len (deref-pointer out-len-ptr #.$ODBC-LONG-TYPE))) - (setf str (uffi:octets-to-string octets)) + do + (if (= c-type #.$SQL_CHAR) + (setf offset (%cstring-into-vector ;string + data-ptr str + offset + (min out-len (1- +max-precision+)))) + (error 'clsql:sql-database-error :message "wrong type. preliminary.")) + while + (and (= res $SQL_SUCCESS_WITH_INFO) + (>= out-len +max-precision+)) + do (setf res (%sql-get-data hstmt column-nr c-type data-ptr + +max-precision+ out-len-ptr) + out-len (get-cast-long out-len-ptr))) (if (= sql-type $SQL_DECIMAL) - (let ((*read-base* 10)) + (let ((*read-base* 10) + (*read-default-float-format* 'double-float)) (read-from-string str)) str)))))) + (setf (deref-pointer out-len-ptr #.$ODBC-LONG-TYPE) #.$SQL_NO_TOTAL) ;; reset the out length for the next row result)) + (def-type c-timestamp-ptr-type (* (:struct sql-c-timestamp))) (def-type c-time-ptr-type (* (:struct sql-c-time))) (def-type c-date-ptr-type (* (:struct sql-c-date))) -(defun timestamp-to-universal-time (ptr) +(defun timestamp-to-clsql-time (ptr) (declare (type c-timestamp-ptr-type ptr)) - (values - (encode-universal-time - (get-slot-value ptr 'sql-c-timestamp 'second) - (get-slot-value ptr 'sql-c-timestamp 'minute) - (get-slot-value ptr 'sql-c-timestamp 'hour) - (get-slot-value ptr 'sql-c-timestamp 'day) - (get-slot-value ptr 'sql-c-timestamp 'month) - (get-slot-value ptr 'sql-c-timestamp 'year)) - (get-slot-value ptr 'sql-c-timestamp 'fraction))) + (clsql-sys:make-time + :second (get-slot-value ptr 'sql-c-timestamp 'second) + :minute (get-slot-value ptr 'sql-c-timestamp 'minute) + :hour (get-slot-value ptr 'sql-c-timestamp 'hour) + :day (get-slot-value ptr 'sql-c-timestamp 'day) + :month (get-slot-value ptr 'sql-c-timestamp 'month) + :year (get-slot-value ptr 'sql-c-timestamp 'year) + :usec (let ((frac (get-slot-value ptr 'sql-c-timestamp 'fraction))) + (if frac (/ frac 1000) 0)))) (defun universal-time-to-timestamp (time &optional (fraction 0)) "TODO: Dead function?" @@ -974,21 +980,20 @@ as possible second argument) to the desired representation of date/time/timestam (get-slot-value ptr 'sql-c-timestamp 'fraction) fraction) ptr)) -(defun date-to-universal-time (ptr) +(defun date-to-clsql-time (ptr) (declare (type c-date-ptr-type ptr)) - (encode-universal-time - 0 0 0 - (get-slot-value ptr 'sql-c-timestamp 'day) - (get-slot-value ptr 'sql-c-timestamp 'month) - (get-slot-value ptr 'sql-c-timestamp 'year))) + (clsql-sys:make-time + :second 0 :minute 0 :hour 0 + :day (get-slot-value ptr 'sql-c-timestamp 'day) + :month (get-slot-value ptr 'sql-c-timestamp 'month) + :year (get-slot-value ptr 'sql-c-timestamp 'year))) -(defun time-to-universal-time (ptr) +(defun time-to-clsql-time (ptr) (declare (type c-time-ptr-type ptr)) - (encode-universal-time - (get-slot-value ptr 'sql-c-timestamp 'second) - (get-slot-value ptr 'sql-c-timestamp 'minute) - (get-slot-value ptr 'sql-c-timestamp 'hour) - 1 1 0)) + (clsql-sys:make-time + :second (get-slot-value ptr 'sql-c-timestamp 'second) + :minute (get-slot-value ptr 'sql-c-timestamp 'minute) + :hour (get-slot-value ptr 'sql-c-timestamp 'hour))) ;;; Added by KMR @@ -1005,16 +1010,18 @@ as possible second argument) to the desired representation of date/time/timestam (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)) +(defun %table-statistics (table hstmt &key unique (ensure t) + &aux (table (princ-to-string + (clsql-sys::unescaped-database-identifier table)))) (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))))) + (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 ((results nil))