X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=db-odbc%2Fodbc-api.lisp;h=b7fd718c608c3ae89a971b5164b6c1c115a0cf7f;hb=b2191fb61b57de37bdd703c1ad9231f87bd5258c;hp=50ef4432d3485df1f6792b2cb01041c8a4e39106;hpb=e567409d9fff3f7231c2a0bb69b345e19de2b246;p=clsql.git diff --git a/db-odbc/odbc-api.lisp b/db-odbc/odbc-api.lisp index 50ef443..b7fd718 100644 --- a/db-odbc/odbc-api.lisp +++ b/db-odbc/odbc-api.lisp @@ -6,8 +6,6 @@ ;;;; Purpose: Low-level ODBC API using UFFI ;;;; Authors: Kevin M. Rosenberg and Paul Meurer ;;;; -;;;; $Id$ -;;;; ;;;; This file, part of CLSQL, is Copyright (c) 2004 by Kevin M. Rosenberg ;;;; and Copyright (C) Paul Meurer 1999 - 2001. All rights reserved. ;;;; @@ -26,10 +24,11 @@ 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)) - (clsql-sys:format-time - nil (clsql-sys:utime->time universal-time) - :format :iso) + (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 @@ -240,7 +239,7 @@ as possible second argument) to the desired representation of date/time/timestam (SQLTransact henv hdbc $SQL_ROLLBACK))) -; col-nr is zero-based in Lisp +; col-nr is zero-based in Lisp but 1 based in sql ; col-nr = :bookmark retrieves a bookmark. (defun %bind-column (hstmt column-nr c-type data-ptr precision out-len-ptr) (with-error-handling @@ -494,6 +493,7 @@ as possible second argument) to the desired representation of date/time/timestam (deref-pointer column-nullable-p-ptr :short))))))) ;; parameter counting is 1-based +;; this function isn't used, which is good because FreeTDS dosn't support it. (defun %describe-parameter (hstmt parameter-nr) (with-foreign-objects ((column-sql-type-ptr :short) (column-precision-ptr #.$ODBC-ULONG-TYPE) @@ -584,8 +584,9 @@ as possible second argument) to the desired representation of date/time/timestam (defun sql-to-c-type (sql-type) (ecase sql-type ((#.$SQL_CHAR #.$SQL_VARCHAR #.$SQL_LONGVARCHAR - #.$SQL_NUMERIC #.$SQL_DECIMAL #.$SQL_BIGINT -8 -9 -10) $SQL_C_CHAR) ;; Added -10 for MSSQL ntext type + #.$SQL_NUMERIC #.$SQL_DECIMAL -8 -9 -10) $SQL_C_CHAR) ;; Added -10 for MSSQL ntext type (#.$SQL_INTEGER $SQL_C_SLONG) + (#.$SQL_BIGINT $SQL_C_SBIGINT) (#.$SQL_SMALLINT $SQL_C_SSHORT) (#.$SQL_DOUBLE $SQL_C_DOUBLE) (#.$SQL_FLOAT $SQL_C_DOUBLE) @@ -604,6 +605,7 @@ as possible second argument) to the desired representation of date/time/timestam (def-type short-pointer-type (* :short)) (def-type int-pointer-type (* :int)) (def-type long-pointer-type (* #.$ODBC-LONG-TYPE)) +(def-type big-pointer-type (* #.$ODBC-BIG-TYPE)) (def-type float-pointer-type (* :float)) (def-type double-pointer-type (* :double)) (def-type string-pointer-type (* :unsigned-char)) @@ -624,6 +626,10 @@ as possible second argument) to the desired representation of date/time/timestam (locally (declare (type long-pointer-type ptr)) (deref-pointer ptr #.$ODBC-LONG-TYPE))) +(defun get-cast-big (ptr) + (locally (declare (type big-pointer-type ptr)) + (deref-pointer ptr #.$ODBC-BIG-TYPE))) + (defun get-cast-single-float (ptr) (locally (declare (type float-pointer-type ptr)) (deref-pointer ptr :float))) @@ -638,13 +644,13 @@ as possible second argument) to the desired representation of date/time/timestam (defun get-cast-binary (ptr len format) "FORMAT is one of :unsigned-byte-vector, :bit-vector (:string, :hex-string)" - (with-cast-pointer (casted ptr :byte) + (with-cast-pointer (casted ptr :unsigned-byte) (ecase format (:unsigned-byte-vector (let ((vector (make-array len :element-type '(unsigned-byte 8)))) (dotimes (i len) (setf (aref vector i) - (deref-array casted '(:array :byte) i))) + (deref-array casted '(:array :unsigned-byte) i))) vector)) (:bit-vector (let ((vector (make-array (ash len 3) :element-type 'bit))) @@ -670,8 +676,7 @@ as possible second argument) to the desired representation of date/time/timestam (#.$SQL_C_SSHORT (get-cast-short data-ptr)) ;; ? (#.$SQL_SMALLINT (get-cast-short data-ptr)) ;; ?? (#.$SQL_INTEGER (get-cast-int data-ptr)) - (#.$SQL_BIGINT (read-from-string - (get-cast-foreign-string data-ptr))) + (#.$SQL_BIGINT (get-cast-big data-ptr)) (#.$SQL_DECIMAL (let ((*read-base* 10)) (read-from-string (get-cast-foreign-string data-ptr)))) @@ -701,6 +706,8 @@ 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)) #+ignore (#.$SQL_C_CHAR (code-char (get-cast-short data-ptr))) @@ -740,6 +747,7 @@ as possible second argument) to the desired representation of date/time/timestam (#.$SQL_C_DOUBLE (uffi:allocate-foreign-object :double)) (#.$SQL_C_BIT (uffi:allocate-foreign-object :byte)) (#.$SQL_C_STINYINT (uffi:allocate-foreign-object :byte)) + (#.$SQL_C_SBIGINT (uffi:allocate-foreign-object #.$ODBC-BIG-TYPE)) (#.$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)))) @@ -903,27 +911,26 @@ as possible second argument) to the desired representation of date/time/timestam (let ((*read-base* 10)) (read-from-string str)) str))) - (otherwise - (let ((str (make-string out-len))) - (loop 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) - #+ingore(eq (sql-state +null-handle-ptr+ +null-handle-ptr+ hstmt) - $sql-data-truncated) - (equal (sql-state +null-handle-ptr+ +null-handle-ptr+ hstmt) - "01004")) - 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))) + (otherwise + (let ((str) + (offset 0) + (octets (make-array out-len :element-type '(unsigned-byte 8) :initial-element 0))) + (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)) (if (= sql-type $SQL_DECIMAL) (let ((*read-base* 10)) (read-from-string str)) - str)))))) + str)))))) (setf (deref-pointer out-len-ptr #.$ODBC-LONG-TYPE) #.$SQL_NO_TOTAL) ;; reset the out length for the next row result)) @@ -1039,3 +1046,4 @@ as possible second argument) to the desired representation of date/time/timestam (free-foreign-object desc))) (nreverse results))) +