X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=db-odbc%2Fodbc-api.lisp;h=33734bc993450096052fbe1b240587c834d1ac1d;hb=fd2493718d0e1114fcbe3dd578dab658ea383e81;hp=492bf826f6dcfaedff31eac124d7da4b5e36a737;hpb=5bfa219c5e3b387b9dd7c819441f0182ccb16dc8;p=clsql.git diff --git a/db-odbc/odbc-api.lisp b/db-odbc/odbc-api.lisp index 492bf82..33734bc 100644 --- a/db-odbc/odbc-api.lisp +++ b/db-odbc/odbc-api.lisp @@ -151,7 +151,7 @@ as possible second argument) to the desired representation of date/time/timestam (with-foreign-object (phenv 'sql-handle) (with-error-handling () - (SQLAllocEnv phenv) + (SQLAllocHandle $SQL_HANDLE_ENV +null-handle-ptr+ phenv) (deref-pointer phenv 'sql-handle))))) (%set-attr-odbc-version henv $SQL_OV_ODBC3) henv)) @@ -164,9 +164,10 @@ as possible second argument) to the desired representation of date/time/timestam (defun %new-db-connection-handle (henv) (with-foreign-object (phdbc 'sql-handle) + (setf (deref-pointer phdbc 'sql-handle) +null-handle-ptr+) (with-error-handling (:henv henv) - (SQLAllocConnect henv phdbc) + (SQLAllocHandle $SQL_HANDLE_DBC henv phdbc) (deref-pointer phdbc 'sql-handle)))) (defun %free-statement (hstmt option) @@ -197,6 +198,20 @@ as possible second argument) to the desired representation of date/time/timestam (SQLConnect hdbc server-ptr $SQL_NTS uid-ptr $SQL_NTS pwd-ptr $SQL_NTS)))) +(defun %sql-driver-connect (hdbc connection-string completion window-handle) + (with-cstring (connection-ptr connection-string) + (let ((completed-connection-string (allocate-foreign-string $SQL_MAX_CONN_OUT))) + (unwind-protect + (with-foreign-object (completed-connection-length :short) + (with-error-handling + (:hdbc hdbc) + (SQLDriverConnect hdbc + window-handle + connection-ptr $SQL_NTS + completed-connection-string $SQL_MAX_CONN_OUT + completed-connection-length + completion))) + (free-foreign-object completed-connection-string))))) (defun %disconnect (hdbc) (with-error-handling @@ -248,11 +263,11 @@ as possible second argument) to the desired representation of date/time/timestam (defun %new-statement-handle (hdbc) (let ((statement-handle - (with-foreign-object (hstmt-ptr 'sql-handle) + (with-foreign-object (phstmt 'sql-handle) (with-error-handling (:hdbc hdbc) - (SQLAllocStmt hdbc hstmt-ptr) - (deref-pointer hstmt-ptr 'sql-handle))))) + (SQLAllocHandle $SQL_HANDLE_STMT hdbc phstmt) + (deref-pointer phstmt 'sql-handle))))) (if (uffi:null-pointer-p statement-handle) (error 'clsql:sql-database-error :message "Received null statement handle.") statement-handle))) @@ -559,7 +574,7 @@ 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) $SQL_C_CHAR) + #.$SQL_NUMERIC #.$SQL_DECIMAL #.$SQL_BIGINT -8 -9 -10) $SQL_C_CHAR) ;; Added -10 for MSSQL ntext type (#.$SQL_INTEGER $SQL_C_SLONG) (#.$SQL_SMALLINT $SQL_C_SSHORT) (#.$SQL_DOUBLE $SQL_C_DOUBLE) @@ -575,13 +590,13 @@ as possible second argument) to the desired representation of date/time/timestam (#.$SQL_TINYINT $SQL_C_STINYINT) (#.$SQL_BIT $SQL_C_BIT))) -(def-type byte-pointer-type '(* :byte)) -(def-type short-pointer-type '(* :short)) -(def-type int-pointer-type '(* :int)) -(def-type long-pointer-type '(* #.$ODBC-LONG-TYPE)) -(def-type float-pointer-type '(* :float)) -(def-type double-pointer-type '(* :double)) -(def-type string-pointer-type '(* :unsigned-char)) +(def-type byte-pointer-type (* :byte)) +(def-type short-pointer-type (* :short)) +(def-type int-pointer-type (* :int)) +(def-type long-pointer-type (* #.$ODBC-LONG-TYPE)) +(def-type float-pointer-type (* :float)) +(def-type double-pointer-type (* :double)) +(def-type string-pointer-type (* :unsigned-char)) (defun get-cast-byte (ptr) (locally (declare (type byte-pointer-type ptr)) @@ -647,7 +662,6 @@ as possible second argument) to the desired representation of date/time/timestam (#.$SQL_INTEGER (get-cast-int data-ptr)) (#.$SQL_BIGINT (read-from-string (get-cast-foreign-string data-ptr))) - (#.$SQL_TINYINT (get-cast-byte data-ptr)) (#.$SQL_DECIMAL (let ((*read-base* 10)) (read-from-string (get-cast-foreign-string data-ptr)))) @@ -848,60 +862,63 @@ as possible second argument) to the desired representation of date/time/timestam (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)) + (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)) - (offset 0)) - (case out-len - (#.$SQL_NULL_DATA - (return-from read-data-in-chunks *null*)) - (#.$SQL_NO_TOTAL ;; don't know how long it is going to be - (let ((str (make-array 0 :element-type 'character :adjustable t))) - (loop do (if (= c-type #.$SQL_CHAR) - (let ((data-length (foreign-string-length data-ptr))) - (adjust-array str (+ offset data-length) - :initial-element #\?) - (setf offset (%cstring-into-vector - data-ptr str - offset - data-length))) - (error 'clsql:sql-database-error :message "wrong type. preliminary.")) - while (and (= res $SQL_SUCCESS_WITH_INFO) - (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))) - (setf str (coerce str 'string)) - (if (= sql-type $SQL_DECIMAL) - (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))) - (if (= sql-type $SQL_DECIMAL) - (let ((*read-base* 10)) - (read-from-string str)) - str)))))) - -(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))) + (offset 0) + (result (case out-len + (#.$SQL_NULL_DATA + (return-from read-data-in-chunks *null*)) + (#.$SQL_NO_TOTAL ;; don't know how long it is going to be + (let ((str (make-array 0 :element-type 'character :adjustable t))) + (loop do (if (= c-type #.$SQL_CHAR) + (let ((data-length (foreign-string-length data-ptr))) + (adjust-array str (+ offset data-length) + :initial-element #\?) + (setf offset (%cstring-into-vector + data-ptr str + offset + data-length))) + (error 'clsql:sql-database-error :message "wrong type. preliminary.")) + while (and (= res $SQL_SUCCESS_WITH_INFO) + (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))) + (setf str (coerce str 'string)) + (if (= sql-type $SQL_DECIMAL) + (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))) + (if (= sql-type $SQL_DECIMAL) + (let ((*read-base* 10)) + (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) (declare (type c-timestamp-ptr-type ptr))