r9438: avoid making new pointers
[clsql.git] / db-oracle / oracle-sql.lisp
index d5fdb8797d3f529ff8ebca8de76ea0a06e125ffc..aedff1bab29dc4cb5889f0f75cdb634f0f3e4dca 100644 (file)
@@ -15,8 +15,7 @@
 
 (in-package #:clsql-oracle)
 
-(defmethod database-initialize-database-type
-    ((database-type (eql :oracle)))
+(defmethod database-initialize-database-type ((database-type (eql :oracle)))
   t)
 
 ;;;; arbitrary parameters, tunable for performance or other reasons
@@ -37,6 +36,13 @@ likely that we'll have to worry about the CMUCL limit."))
 
 ;; constants - from OCI?
 
+(defvar +unsigned-char-null-pointer+
+  (uffi:make-null-pointer :unsigned-char))
+(defvar +unsigned-short-null-pointer+
+  (uffi:make-null-pointer :unsigned-short))
+(defvar +unsigned-int-null-pointer+
+  (uffi:make-null-pointer :unsigned-int))
+
 (defconstant +var-not-in-list+       1007)
 (defconstant +no-data-found+         1403)
 (defconstant +null-value-returned+   1405)
@@ -104,12 +110,24 @@ the length of that format.")
     :reader server-version
     :documentation
     "Version string of Oracle server.")
-   (major-version-number
+   (major-server-version
+    :type (or null fixnum)
+    :initarg :major-server-version
+    :reader major-server-version
+    :documentation
+    "The major version number of the Oracle server, should be 8, 9, or 10")
+   (client-version 
+    :type string
+    :initarg :client-version
+    :reader client-version
+    :documentation
+    "Version string of Oracle client.")
+   (major-client-version
     :type (or null fixnum)
-    :initarg :major-version-number
-    :reader major-version-number
+    :initarg :major-client-version
+    :reader major-client-version
     :documentation
-    "The major version number of Oracle, should be 8, 9, or 10")))
+    "The major version number of the Oracle client, should be 8, 9, or 10")))
 
 
 ;;; Handle the messy case of return code=+oci-error+, querying the
@@ -193,7 +211,7 @@ the length of that format.")
 (uffi:def-type string-array (:array :unsigned-char))
 
 (defun deref-oci-string (arrayptr string-index size)
-  (declare (type string-array arrayptr))
+;;  (declare (type string-array arrayptr))
   (declare (type (mod #.+n-buf-rows+) string-index))
   (declare (type (and unsigned-byte fixnum) size))
   (let* ((raw (uffi:convert-from-foreign-string 
@@ -403,7 +421,7 @@ the length of that format.")
                    (value
                     (let* ((arb (foreign-resource-buffer (cd-indicators cd)))
                            (indicator (uffi:deref-array arb '(:array :short) irow)))
-                      (declare (type short-array arb))
+                      ;;(declare (type short-array arb))
                       (unless (= indicator -1)
                         (ecase (cd-oci-data-type cd)
                           (#.SQLT-STR  
@@ -443,7 +461,7 @@ the length of that format.")
              (oci-attr-get (deref-vp (qc-stmthp qc))
                           +oci-htype-stmt+
                            rowcount 
-                          (uffi:make-null-pointer :unsigned-long)
+                          +unsigned-int-null-pointer+
                           +oci-attr-row-count+ 
                            (deref-vp errhp))
              (setf (qc-n-from-oci qc)
@@ -487,7 +505,7 @@ the length of that format.")
         (oci-attr-get (deref-vp stmthp) 
                      +oci-htype-stmt+ 
                       stmttype
-                     (uffi:make-null-pointer :unsigned-int)
+                     +unsigned-int-null-pointer+
                      +oci-attr-stmt-type+ 
                       (deref-vp errhp)
                      :database db)
@@ -612,7 +630,7 @@ the length of that format.")
          (oci-attr-get (deref-vp parmdp)
                        +oci-dtype-param+ 
                        dtype-foreign
-                       (uffi:make-null-pointer :unsigned-int)
+                       +unsigned-int-null-pointer+
                        +oci-attr-data-type+
                        (deref-vp errhp))
          (let ((dtype (uffi:deref-pointer dtype-foreign :unsigned-short)))
@@ -625,13 +643,13 @@ the length of that format.")
               (oci-attr-get (deref-vp parmdp)
                             +oci-dtype-param+
                             precision
-                            (uffi:make-null-pointer :unsigned-int)
+                            +unsigned-int-null-pointer+
                             +oci-attr-precision+
                             (deref-vp errhp))
               (oci-attr-get (deref-vp parmdp)
                             +oci-dtype-param+
                             scale
-                            (uffi:make-null-pointer :unsigned-int)
+                            +unsigned-int-null-pointer+
                             +oci-attr-scale+
                             (deref-vp errhp))
               (let ((*scale (uffi:deref-pointer scale :byte))
@@ -654,7 +672,7 @@ the length of that format.")
               (oci-attr-get (deref-vp parmdp)
                             +oci-dtype-param+ 
                             colsize
-                            (uffi:make-null-pointer :unsigned-int) ;;  (uffi:pointer-address colsizesize) 
+                            +unsigned-int-null-pointer+
                             +oci-attr-data-size+
                             (deref-vp errhp))
               (let ((colsize-including-null (1+ (uffi:deref-pointer colsize :unsigned-long))))
@@ -692,15 +710,12 @@ the length of that format.")
                                 defnp
                                 (deref-vp errhp)
                                 (1+ icolumn) ; OCI 1-based indexing again
-                                (uffi:with-cast-pointer (vp (foreign-resource-buffer buffer) :void)
-                                  vp)
+                                (foreign-resource-buffer buffer)
                                 sizeof
                                 dtype
-                                (uffi:with-cast-pointer (vp (foreign-resource-buffer indicators) :void)
-                                  vp)
-                                (uffi:make-null-pointer :unsigned-short)
-                                (uffi:with-cast-pointer (vp (foreign-resource-buffer retcodes) :unsigned-short)
-                                  vp)
+                                (foreign-resource-buffer indicators)
+                                +unsigned-short-null-pointer+
+                                (foreign-resource-buffer retcodes)
                                 +oci-default+))))))))
   
 ;; Release the resources associated with a QUERY-CURSOR.
@@ -780,26 +795,38 @@ the length of that format.")
        )
       ;; Actually, oci-server-version returns the client version, not the server versions
       ;; will use "SELECT VERSION FROM V$INSTANCE" to get actual server version.
-      (let (db server-version)
+      (let (db server-version client-version)
+       (declare (ignorable server-version))
        (uffi:with-foreign-object (buf '(:array :unsigned-char #.+errbuf-len+))
          (oci-server-version (deref-vp svchp)
                              (deref-vp errhp)
                              (uffi:char-array-to-pointer buf)
                              +errbuf-len+ +oci-htype-svcctx+)
+         (setf client-version (uffi:convert-from-foreign-string buf))
+         ;; This returns the client version, not the server version, so diable it
+         #+ignore
+         (oci-server-version (deref-vp srvhp)
+                             (deref-vp errhp)
+                             (uffi:char-array-to-pointer buf)
+                             +errbuf-len+ +oci-htype-server+)
+         #+ignore
          (setf server-version (uffi:convert-from-foreign-string buf)))
        (setq db (make-instance 'oracle-database
                                :name (database-name-from-spec connection-spec
                                                               database-type)
+                               :connection-spec connection-spec
                                :envhp envhp
                                :errhp errhp
                                :database-type :oracle
                                :svchp svchp
                                :dsn data-source-name
                                :user user
+                               :client-version client-version
                                :server-version server-version
-                               :major-version-number (major-version-from-string
+                               :major-client-version (major-client-version-from-string
+                                                      client-version)
+                               :major-server-version (major-client-version-from-string
                                                       server-version)))
-
        (oci-logon (deref-vp envhp)
                   (deref-vp errhp) 
                   svchp
@@ -810,16 +837,32 @@ the length of that format.")
        ;; :date-format-length (1+ (length date-format)))))
        (setf (slot-value db 'clsql-sys::state) :open)
         (database-execute-command
-        (format nil "alter session set NLS_DATE_FORMAT='~A'" (date-format db)) db)
+        (format nil "ALTER SESSION SET NLS_DATE_FORMAT='~A'" (date-format db)) db)
+       (let ((server-version (caar (database-query "SELECT BANNER FROM V$VERSION WHERE BANNER LIKE '%Oracle%'" db nil nil))))
+         (setf (slot-value db 'server-version) server-version
+               (slot-value db 'major-server-version) (major-client-version-from-string
+                                                      server-version)))
         db))))
 
 
-(defun major-version-from-string (str)
+(defun major-client-version-from-string (str)
   (cond 
     ((search " 10g " str)
      10)
-    ((search "Oracle9i  " str)
-     10)))
+    ((search "Oracle9i " str)
+     9)
+    ((search "Oracle8" str)
+     8)))
+
+(defun major-server-version-from-string (str)
+  (when (> (length str) 2)
+    (cond 
+      ((string= "10." (subseq str 0 3))
+       10)
+      ((string= "9." (subseq str 0 2))
+       9)
+      ((string= "8." (subseq str 0 2))
+       8))))
 
 
 ;; Close a database connection.