X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=db-odbc%2Fodbc-api.lisp;h=a15d628f8c3c82120ed7cbf7e91f00ba5f6465b2;hb=d107be8f0cad113b96b6cfe443cc4d7c08126db4;hp=86505da017a5141e08e5b5c8959ff1e72f377d08;hpb=6e8ef7161f2d2759bf8d78740e7e93bea5eca781;p=clsql.git diff --git a/db-odbc/odbc-api.lisp b/db-odbc/odbc-api.lisp index 86505da..a15d628 100644 --- a/db-odbc/odbc-api.lisp +++ b/db-odbc/odbc-api.lisp @@ -31,6 +31,7 @@ May be locally bound to something else if a certain type is necessary.") as possible second argument) to the desired representation of date/time/timestamp.") (defvar +null-ptr+ (make-null-pointer :byte)) +(defparameter +null-handle-ptr+ (make-null-pointer :void)) (defvar *info-output* nil "Stream to send SUCCESS_WITH_INFO messages.") @@ -56,36 +57,36 @@ as possible second argument) to the desired representation of date/time/timestam (defun handle-error (henv hdbc hstmt) (let ((sql-state (allocate-foreign-string 256)) - (error-message (allocate-foreign-string $SQL_MAX_MESSAGE_LENGTH))) + (error-message (allocate-foreign-string #.$SQL_MAX_MESSAGE_LENGTH))) (with-foreign-objects ((error-code :long) (msg-length :short)) (SQLError henv hdbc hstmt sql-state error-code error-message - $SQL_MAX_MESSAGE_LENGTH msg-length) - (values - (prog1 - (convert-from-foreign-string error-message) - (free-foreign-object error-message)) - (prog1 - (convert-from-foreign-string sql-state) - (free-foreign-object error-message)) - (deref-pointer msg-length :short) - (deref-pointer error-code :long))))) + #.$SQL_MAX_MESSAGE_LENGTH msg-length) + (let ((err (convert-from-foreign-string error-message)) + (state (convert-from-foreign-string sql-state))) + (free-foreign-object error-message) + (free-foreign-object sql-state) + (values + err + state + (deref-pointer msg-length :short) + (deref-pointer error-code :long)))))) (defun sql-state (henv hdbc hstmt) (let ((sql-state (allocate-foreign-string 256)) - (error-message (allocate-foreign-string $SQL_MAX_MESSAGE_LENGTH))) + (error-message (allocate-foreign-string #.$SQL_MAX_MESSAGE_LENGTH))) (with-foreign-objects ((error-code :long) (msg-length :short)) (SQLError henv hdbc hstmt sql-state error-code - error-message $SQL_MAX_MESSAGE_LENGTH msg-length) - (free-foreign-object error-message) - (prog1 - (convert-from-foreign-string sql-state) - (free-foreign-object sql-state))) - ;; test this: return a keyword for efficiency - ;;(%cstring-to-keyword sql-state) - )) + error-message #.$SQL_MAX_MESSAGE_LENGTH msg-length) + (let ((state (convert-from-foreign-string sql-state))) + (free-foreign-object error-message) + (free-foreign-object sql-state) + state + ;; test this: return a keyword for efficiency + ;;(%cstring-to-keyword state) + )))) (defmacro with-error-handling ((&key henv hdbc hstmt (print-info t)) odbc-call &body body) @@ -97,9 +98,9 @@ as possible second argument) to the desired representation of date/time/timestam (#.$SQL_SUCCESS_WITH_INFO (when ,print-info (multiple-value-bind (error-message sql-state) - (handle-error (or ,henv +null-ptr+) - (or ,hdbc +null-ptr+) - (or ,hstmt +null-ptr+)) + (handle-error (or ,henv +null-handle-ptr+) + (or ,hdbc +null-handle-ptr+) + (or ,hstmt +null-handle-ptr+)) (when *info-output* (format *info-output* "[ODBC info ~A] ~A state: ~A" ,result-code error-message @@ -115,9 +116,9 @@ as possible second argument) to the desired representation of date/time/timestam :odbc-message "Still executing")) (#.$SQL_ERROR (multiple-value-bind (error-message sql-state) - (handle-error (or ,henv +null-ptr+) - (or ,hdbc +null-ptr+) - (or ,hstmt +null-ptr+)) + (handle-error (or ,henv +null-handle-ptr+) + (or ,hdbc +null-handle-ptr+) + (or ,hstmt +null-handle-ptr+)) (error 'clsql-base-sys:clsql-odbc-error :odbc-message error-message @@ -273,9 +274,9 @@ as possible second argument) to the desired representation of date/time/timestam (with-error-handling (:hdbc hdbc) (SQLGetInfo hdbc info-type info-ptr 1023 info-length-ptr) - (prog1 - (convert-from-foreign-string info-ptr) - (free-foreign-object info-ptr)))))) + (let ((info (convert-from-foreign-string info-ptr))) + (free-foreign-object info-ptr) + info))))) ;; those returning a word ((#.$SQL_ACTIVE_CONNECTIONS #.$SQL_ACTIVE_STATEMENTS @@ -424,7 +425,7 @@ as possible second argument) to the desired representation of date/time/timestam (let ((column-name-ptr (allocate-foreign-string 256))) (with-foreign-objects ((column-name-length-ptr :short) (column-sql-type-ptr :short) - (column-precision-ptr :long) + (column-precision-ptr :unsigned-long) (column-scale-ptr :short) (column-nullable-p-ptr :short)) (with-error-handling (:hstmt hstmt) @@ -439,14 +440,14 @@ as possible second argument) to the desired representation of date/time/timestam (values column-name (deref-pointer column-sql-type-ptr :short) - (deref-pointer column-precision-ptr :long) + (deref-pointer column-precision-ptr :unsigned-long) (deref-pointer column-scale-ptr :short) (deref-pointer column-nullable-p-ptr :short))))))) ;; parameter counting is 1-based (defun %describe-parameter (hstmt parameter-nr) (with-foreign-objects ((column-sql-type-ptr :short) - (column-precision-ptr :long) + (column-precision-ptr :unsigned-long) (column-scale-ptr :short) (column-nullable-p-ptr :short)) (with-error-handling @@ -458,7 +459,7 @@ as possible second argument) to the desired representation of date/time/timestam column-nullable-p-ptr) (values (deref-pointer column-sql-type-ptr :short) - (deref-pointer column-precision-ptr :long) + (deref-pointer column-precision-ptr :unsigned-long) (deref-pointer column-scale-ptr :short) (deref-pointer column-nullable-p-ptr :short))))) @@ -471,11 +472,11 @@ as possible second argument) to the desired representation of date/time/timestam (SQLColAttributes hstmt column-nr descriptor-type descriptor-info-ptr 256 descriptor-length-ptr numeric-descriptor-ptr) - (values - (prog1 - (convert-from-foreign-string descriptor-info-ptr) - (free-foreign-object descriptor-info-ptr)) - (deref-pointer numeric-descriptor-ptr :long)))))) + (let ((desc (convert-from-foreign-string descriptor-info-ptr))) + (free-foreign-object descriptor-info-ptr) + (values + desc + (deref-pointer numeric-descriptor-ptr :long))))))) (defun %prepare-describe-columns (hstmt table-qualifier table-owner table-name column-name) @@ -515,14 +516,21 @@ as possible second argument) to the desired representation of date/time/timestam description-ptr 1024 description-length-ptr)))) - (unless (= res $SQL_NO_DATA_FOUND) - (values - (prog1 - (convert-from-foreign-string name-ptr) - (free-foreign-object name-ptr)) - (prog1 - (convert-from-foreign-string description-ptr) - (free-foreign-object description-ptr)))))))) + (cond + ((= res $SQL_NO_DATA_FOUND) + (let ((name (convert-from-foreign-string name-ptr)) + (desc (convert-from-foreign-string description-ptr))) + (free-foreign-object name-ptr) + (free-foreign-object description-ptr) + (values + name + desc))) + (t + (free-foreign-object name-ptr) + (free-foreign-object description-ptr) + nil)))))) + + (defun sql-to-c-type (sql-type) (ecase sql-type @@ -831,7 +839,7 @@ as possible second argument) to the desired representation of date/time/timestam data-length))) (error "wrong type. preliminary.")) while (and (= res $SQL_SUCCESS_WITH_INFO) - (equal (sql-state +null-ptr+ +null-ptr+ hstmt) + (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))) @@ -850,9 +858,9 @@ as possible second argument) to the desired representation of date/time/timestam (error "wrong type. preliminary.")) while (and (= res $SQL_SUCCESS_WITH_INFO) - #+ingore(eq (sql-state +null-ptr+ +null-ptr+ hstmt) + #+ingore(eq (sql-state +null-handle-ptr+ +null-handle-ptr+ hstmt) $sql-data-truncated) - (equal (sql-state +null-ptr+ +null-ptr+ hstmt) + (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)