r9403: Rework conditions to be CommonSQL backward compatible

[clsql.git] / db-odbc / odbc-api.lisp

diff --git a/db-odbc/odbc-api.lisp b/db-odbc/odbc-api.lisp
index b9223d68fb7d44cdb35e3c6380f5e3abeaf17c05..94017dc1132170999daf1463445089f20f2bdda2 100644 (file)
--- a/db-odbc/odbc-api.lisp
+++ b/db-odbc/odbc-api.lisp
@@ -27,8 +27,8 @@ May be locally bound to something else if a certain type is necessary.")
 (defvar *time-conversion-function*
     (lambda (universal-time &optional fraction)
       (declare (ignore fraction))
-      (clsql-base:format-time 
-       nil (clsql-base:utime->time universal-time) 
+      (clsql-sys:format-time 
+       nil (clsql-sys:utime->time universal-time) 
        :format :iso)
       #+ignore
       universal-time)
@@ -63,7 +63,7 @@ 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)))
-    (with-foreign-objects ((error-code :long)
+    (with-foreign-objects ((error-code #.$ODBC-LONG-TYPE)
                           (msg-length :short))
       (SQLError henv hdbc hstmt sql-state
                error-code error-message
@@ -76,12 +76,12 @@ as possible second argument) to the desired representation of date/time/timestam
         err
         state
         (deref-pointer msg-length :short) 
-        (deref-pointer error-code :long))))))
+        (deref-pointer error-code #.$ODBC-LONG-TYPE))))))
 
 (defun sql-state (henv hdbc hstmt)
   (let ((sql-state (allocate-foreign-string 256))
        (error-message (allocate-foreign-string #.$SQL_MAX_MESSAGE_LENGTH)))
-    (with-foreign-objects ((error-code :long)
+    (with-foreign-objects ((error-code #.$ODBC-LONG-TYPE)
                           (msg-length :short))
       (SQLError henv hdbc hstmt sql-state error-code
                error-message #.$SQL_MAX_MESSAGE_LENGTH msg-length)
@@ -113,22 +113,35 @@ 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
-          :odbc-message "Invalid handle"))
+          'clsql-sys:sql-database-error
+          :message "ODBC: Invalid handle"))
          (#.$SQL_STILL_EXECUTING
           (error
-          'clsql-base-sys:clsql-odbc-error
-          :odbc-message "Still executing"))
+          'clsql-sys:sql-temporary-error
+          :message "ODBC: Still executing"))
          (#.$SQL_ERROR
           (multiple-value-bind (error-message sql-state)
              (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
+            'clsql-sys:sql-database-error
+            :message error-message
             :sql-state sql-state)))
+        (#.$SQL_NO_DATA_FOUND
+         (progn ,result-code ,@body))
+        ;; work-around for Allegro 7.0beta AMD64 which
+        ;; has for negative numbers
         (otherwise
+         (multiple-value-bind (error-message sql-state)
+             (handle-error (or ,henv +null-handle-ptr+)
+                           (or ,hdbc +null-handle-ptr+)
+                           (or ,hstmt +null-handle-ptr+))
+            (error
+            'clsql-sys:sql-database-error
+            :message error-message
+            :secondary-error-id sql-state))
+         #+ignore
           (progn ,result-code ,@body))))))
 
 (defun %new-environment-handle ()
@@ -232,12 +245,16 @@ as possible second argument) to the desired representation of date/time/timestam
       (SQLFetch hstmt)))
 
 (defun %new-statement-handle (hdbc)
-  (with-foreign-object (hstmt-ptr 'sql-handle)
-    (with-error-handling 
-      (:hdbc hdbc)
-      (SQLAllocStmt hdbc hstmt-ptr) 
-      (deref-pointer hstmt-ptr 'sql-handle))))
-
+  (let ((statement-handle
+        (with-foreign-object (hstmt-ptr 'sql-handle)
+          (with-error-handling 
+              (:hdbc hdbc)
+            (SQLAllocStmt hdbc hstmt-ptr) 
+            (deref-pointer hstmt-ptr 'sql-handle)))))
+    (if (uffi:null-pointer-p statement-handle)
+       (error "Received null statement handle.")
+       statement-handle)))
+       
 (defun %sql-get-info (hdbc info-type)
   (ecase info-type
     ;; those return string
@@ -367,7 +384,7 @@ as possible second argument) to the desired representation of date/time/timestam
       #.$SQL_TIMEDATE_FUNCTIONS
       #.$SQL_TXN_ISOLATION_OPTION
       #.$SQL_UNION)
-     (with-foreign-objects ((info-ptr :long)
+     (with-foreign-objects ((info-ptr #.$ODBC-LONG-TYPE)
                            (info-length-ptr :short))
        (with-error-handling 
          (:hdbc hdbc)
@@ -376,7 +393,7 @@ as possible second argument) to the desired representation of date/time/timestam
                     info-ptr
                     255
                     info-length-ptr)
-         (deref-pointer info-ptr :long)))
+         (deref-pointer info-ptr #.$ODBC-LONG-TYPE)))
      )
     ;; those returning a long integer
     ((#.$SQL_DEFAULT_TXN_ISOLATION
@@ -390,12 +407,12 @@ as possible second argument) to the desired representation of date/time/timestam
       #.$SQL_MAX_CHAR_LITERAL_LEN
       #.$SQL_ACTIVE_ENVIRONMENTS
       )
-     (with-foreign-objects ((info-ptr :long)
+     (with-foreign-objects ((info-ptr #.$ODBC-LONG-TYPE)
                            (info-length-ptr :short))
        (with-error-handling 
          (:hdbc hdbc)
          (SQLGetInfo hdbc info-type info-ptr 255 info-length-ptr)
-         (deref-pointer info-ptr :long))))))
+         (deref-pointer info-ptr #.$ODBC-LONG-TYPE))))))
      
 (defun %sql-exec-direct (sql hstmt henv hdbc)
   (with-cstring (sql-ptr sql)
@@ -420,17 +437,17 @@ as possible second argument) to the desired representation of date/time/timestam
       (deref-pointer columns-nr-ptr :short))))
 
 (defun result-rows-count (hstmt)
-  (with-foreign-objects ((row-count-ptr :long))
+  (with-foreign-objects ((row-count-ptr #.$ODBC-LONG-TYPE))
     (with-error-handling (:hstmt hstmt)
                          (SQLRowCount hstmt row-count-ptr)
-      (deref-pointer row-count-ptr :long))))
+      (deref-pointer row-count-ptr #.$ODBC-LONG-TYPE))))
 
 ;; column counting is 1-based
 (defun %describe-column (hstmt column-nr)
   (let ((column-name-ptr (allocate-foreign-string 256)))
     (with-foreign-objects ((column-name-length-ptr :short)
                           (column-sql-type-ptr :short)
-                          (column-precision-ptr :unsigned-long)
+                          (column-precision-ptr #.$ODBC-ULONG-TYPE)
                           (column-scale-ptr :short)
                           (column-nullable-p-ptr :short))
       (with-error-handling (:hstmt hstmt)
@@ -445,14 +462,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 :unsigned-long)
+          (deref-pointer column-precision-ptr #.$ODBC-ULONG-TYPE)
           (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 :unsigned-long)
+                        (column-precision-ptr #.$ODBC-ULONG-TYPE)
                         (column-scale-ptr :short)
                         (column-nullable-p-ptr :short))
     (with-error-handling 
@@ -464,14 +481,14 @@ 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 :unsigned-long)
+       (deref-pointer column-precision-ptr #.$ODBC-ULONG-TYPE)
        (deref-pointer column-scale-ptr :short)
        (deref-pointer column-nullable-p-ptr :short)))))
 
 (defun %column-attributes (hstmt column-nr descriptor-type)
   (let ((descriptor-info-ptr (allocate-foreign-string 256)))
     (with-foreign-objects ((descriptor-length-ptr :short)
-                          (numeric-descriptor-ptr :long))
+                          (numeric-descriptor-ptr #.$ODBC-LONG-TYPE))
       (with-error-handling
          (:hstmt hstmt) 
          (SQLColAttributes hstmt column-nr descriptor-type descriptor-info-ptr
@@ -481,7 +498,7 @@ as possible second argument) to the desired representation of date/time/timestam
          (free-foreign-object descriptor-info-ptr)
          (values
           desc
-          (deref-pointer numeric-descriptor-ptr :long)))))))
+          (deref-pointer numeric-descriptor-ptr #.$ODBC-LONG-TYPE)))))))
   
 (defun %prepare-describe-columns (hstmt table-qualifier table-owner 
                                    table-name column-name)
@@ -556,7 +573,7 @@ as possible second argument) to the desired representation of date/time/timestam
 (def-type byte-pointer-type '(* :byte))
 (def-type short-pointer-type '(* :short))
 (def-type int-pointer-type '(* :int))
-(def-type long-pointer-type '(* :long))
+(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))
@@ -575,7 +592,7 @@ as possible second argument) to the desired representation of date/time/timestam
 
 (defun get-cast-long (ptr)
   (locally (declare (type long-pointer-type ptr))
-    (deref-pointer ptr :long)))
+    (deref-pointer ptr #.$ODBC-LONG-TYPE)))
 
 (defun get-cast-single-float (ptr)
   (locally (declare (type float-pointer-type ptr))
@@ -611,7 +628,7 @@ 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 :long))
+  (let* ((out-len (deref-pointer out-len-ptr #.$ODBC-LONG-TYPE))
         (value
          (cond ((= out-len $SQL_NULL_DATA)
                 *null*)
@@ -663,6 +680,7 @@ as possible second argument) to the desired representation of date/time/timestam
     ;; FIXME: this could be better optimized for types which use READ-FROM-STRING above
     
     (if (and (or (eq result-type t) (eq result-type :string))
+            value
             (not (stringp value)))
        (write-to-string value)
       value)))
@@ -684,14 +702,14 @@ as possible second argument) to the desired representation of date/time/timestam
          (long-p (= size +max-precision+))
          (data-ptr
           (case c-type ;; add more?
-            (#.$SQL_C_SLONG (uffi:allocate-foreign-object :long))
+            (#.$SQL_C_SLONG (uffi:allocate-foreign-object #.$ODBC-LONG-TYPE))
             (#.$SQL_C_DATE (allocate-foreign-object 'sql-c-date))
             (#.$SQL_C_TIME (allocate-foreign-object 'sql-c-time))
             (#.$SQL_C_TIMESTAMP (allocate-foreign-object 'sql-c-timestamp))
            (#.$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))))
@@ -701,7 +719,7 @@ as possible second argument) to the desired representation of date/time/timestam
                   (break "SQL type is ~A, precision ~D, size ~D, C type is ~A" 
                          sql-type precision size c-type))
                 (uffi:allocate-foreign-object :byte (1+ size)))))
-         (out-len-ptr (uffi:allocate-foreign-object :long)))
+         (out-len-ptr (uffi:allocate-foreign-object #.$ODBC-LONG-TYPE)))
     (values c-type data-ptr out-len-ptr size long-p)))
 
 (defun fetch-all-rows (hstmt &key free-option flatp)
@@ -775,10 +793,10 @@ as possible second argument) to the desired representation of date/time/timestam
 
 ;; depending on option, we return a long int or a string; string not implemented
 (defun get-connection-option (hdbc option)
-  (with-foreign-object (param-ptr :long)
+  (with-foreign-object (param-ptr #.$ODBC-LONG-TYPE)
     (with-error-handling (:hdbc hdbc)
                          (SQLGetConnectOption hdbc option param-ptr)
-      (deref-pointer param-ptr :long))))
+      (deref-pointer param-ptr #.$ODBC-LONG-TYPE))))
 
 (defun set-connection-option (hdbc option param)
   (with-error-handling (:hdbc hdbc)
@@ -796,12 +814,12 @@ as possible second argument) to the desired representation of date/time/timestam
     (SQLSetPos hstmt row option lock)))
 
 (defun %sql-extended-fetch (hstmt fetch-type row)
-  (with-foreign-objects ((row-count-ptr :unsigned-long)
+  (with-foreign-objects ((row-count-ptr #.$ODBC-ULONG-TYPE)
                         (row-status-ptr :short))
     (with-error-handling (:hstmt hstmt)
       (SQLExtendedFetch hstmt fetch-type row row-count-ptr
                        row-status-ptr)
-      (values (deref-pointer row-count-ptr :unsigned-long)
+      (values (deref-pointer row-count-ptr #.$ODBC-ULONG-TYPE)
               (deref-pointer row-status-ptr :short)))))
 
 ; column-nr is zero-based
@@ -827,7 +845,7 @@ as possible second argument) to the desired representation of date/time/timestam
   (declare (type long-ptr-type out-len-ptr))
   (let* ((res (%sql-get-data hstmt column-nr c-type data-ptr 
                              +max-precision+ out-len-ptr))
-         (out-len (deref-pointer out-len-ptr :long))
+         (out-len (deref-pointer out-len-ptr #.$ODBC-LONG-TYPE))
          (offset 0))
     (case out-len
       (#.$SQL_NULL_DATA
@@ -869,7 +887,7 @@ as possible second argument) to the desired representation of date/time/timestam
                            "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 :long)))
+                        out-len (deref-pointer out-len-ptr #.$ODBC-LONG-TYPE)))
          (if (= sql-type $SQL_DECIMAL)
              (let ((*read-base* 10))
                (read-from-string str))
@@ -952,7 +970,7 @@ as possible second argument) to the desired representation of date/time/timestam
        hstmt
        +null-ptr+ 0
        +null-ptr+ 0
-       table-cs (length table) ;;$SQL_NTS
+       table-cs $SQL_NTS
        (if unique $SQL_INDEX_UNIQUE $SQL_INDEX_ALL)
        (if ensure $SQL_ENSURE $SQL_QUICK)))))