r9398: oracle backend now compiles on sbcl/lispworks

[clsql.git] / db-oracle / oracle-sql.lisp

diff --git a/db-oracle/oracle-sql.lisp b/db-oracle/oracle-sql.lisp
index 7d605933c1953ea32be291a9f560f3f3579e5141..7e471a9c0647c21fd8d23e85ec4d55fef9abda0f 100644 (file)
--- a/db-oracle/oracle-sql.lisp
+++ b/db-oracle/oracle-sql.lisp
@@ -1,47 +1,36 @@
-;;; -*- Mode: Lisp -*-
-;;; $Id$
-
-;;; MaiSQL --- Common Lisp Interface Layer to SQL Databases
-;;; This is copyrighted software.  See documentation for terms.
-;;; 
-;;; oracle-sql.lisp --- SQL-Interface implementation for Oracle
-;;;
-;;; derived from postgresql.lisp
-
-(in-package :clsql-oracle)
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          oracle-sql.lisp
+;;;;
+;;;; $Id$
+;;;;
+;;;; This file is part of CLSQL.
+;;;;
+;;;; CLSQL users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser GNU Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+;;;; *************************************************************************
+
+(in-package #:clsql-oracle)

 
 (defmethod database-initialize-database-type
     ((database-type (eql :oracle)))
   t)
 
 
 (defmethod database-initialize-database-type
     ((database-type (eql :oracle)))
   t)
 

-;;;; KLUDGE: The original prototype of this code was implemented using
-;;;; lots of special variables holding MAKE-ALIEN values. When I was 
-;;;; first converting it to use WITH-ALIEN variables, I was confused
-;;;; about the behavior of MAKE-ALIEN and WITH-ALIEN; I thought that
-;;;; (MAKE-ALIEN TYPEFOO) returned the same type of object as is bound
-;;;; to the name BAR by (WITH-ALIEN ((BAR TYPEFOO)) ..). In fact the
-;;;; value returned by MAKE-ALIEN has an extra level of indirection
-;;;; relative to the value bound by WITH-ALIEN, i.e.  (DEREF
-;;;; (MAKE-ALIEN TYPEFOO)) has the same type as the value bound to the
-;;;; name BAR by (WITH-ALIEN ((BAR TYPEFOO)) ..). Laboring under my
-;;;; misunderstanding, I was unable to use ordinary scalars bound by
-;;;; WITH-ALIEN, and I ended up giving up and deciding to work around
-;;;; this apparent bug in CMUCL by using 1-element arrays instead.
-;;;; This "workaround" for my misunderstanding is obviously unnecessary
-;;;; and confusing, but still remains in the code. -- WHN 20000106
-
-

 ;;;; arbitrary parameters, tunable for performance or other reasons
 
 ;;;; arbitrary parameters, tunable for performance or other reasons
 

-;;; the number of table rows that we buffer at once when reading a table
-;;;
-;;; CMUCL has a compiled-in limit on how much C data can be allocated
-;;; (through malloc() and friends) at any given time, typically 8 Mb.
-;;; Setting this constant to a moderate value should make it less
-;;; likely that we'll have to worry about the CMUCL limit.
-(defconstant +n-buf-rows+ 200)
-;;; the number of characters that we allocate for an error message buffer
-(defconstant +errbuf-len+ 512)
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defconstant +errbuf-len+ 512
+    "the number of characters that we allocate for an error message buffer")
+  (defconstant +n-buf-rows+ 200
+    "the number of table rows that we buffer at once when reading a table.
+CMUCL has a compiled-in limit on how much C data can be allocated
+(through malloc() and friends) at any given time, typically 8 Mb.
+Setting this constant to a moderate value should make it less
+likely that we'll have to worry about the CMUCL limit."))
+

 
 ;;; utilities for mucking around with C-level stuff
 
 
 ;;; utilities for mucking around with C-level stuff
 


@@ -52,8 +41,8 @@
 ;; 1-element arrays running around due to the workaround for the CMUCL
 ;; 18b WITH-ALIEN scalar bug.
 
 ;; 1-element arrays running around due to the workaround for the CMUCL
 ;; 18b WITH-ALIEN scalar bug.
 

-(defmacro c-& (alien-object &rest indices)
-  `(addr (deref ,alien-object ,@indices)))
+(defmacro c-& (alien-object type)
+  `(uffi:pointer-address (uffi:deref-pointer ,alien-object ,type)))

 
 ;; constants - from OCI?
 
 
 ;; constants - from OCI?
 


@@ -62,10 +51,11 @@
 (defconstant +null-value-returned+   1405)
 (defconstant +field-truncated+       1406)
 
 (defconstant +null-value-returned+   1405)
 (defconstant +field-truncated+       1406)
 

-(defconstant SQLT-INT 3)
-(defconstant SQLT-STR 5)
-(defconstant SQLT-FLT 4)
-(defconstant SQLT-DATE 12)
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defconstant SQLT-INT 3)
+  (defconstant SQLT-STR 5)
+  (defconstant SQLT-FLT 4)
+  (defconstant SQLT-DATE 12))

 
 ;;; Note that despite the suggestive class name (and the way that the
 ;;; *DEFAULT-DATABASE* variable holds an object of this class), a DB
 
 ;;; Note that despite the suggestive class name (and the way that the
 ;;; *DEFAULT-DATABASE* variable holds an object of this class), a DB


@@ -73,23 +63,25 @@
 ;;; database. Thus, there's no obstacle to having any number of DB
 ;;; objects referring to the same database.
 
 ;;; database. Thus, there's no obstacle to having any number of DB
 ;;; objects referring to the same database.
 

+(uffi:def-type pointer-pointer-void '(* :pointer-void))
+

 (defclass oracle-database (database)    ; was struct db
   ((envhp
     :reader envhp
     :initarg :envhp
 (defclass oracle-database (database)    ; was struct db
   ((envhp
     :reader envhp
     :initarg :envhp

-    :type (alien (* (* t)))
+    :type pointer-pointer-void

     :documentation
     "OCI environment handle")
    (errhp
     :reader errhp
     :initarg :errhp
     :documentation
     "OCI environment handle")
    (errhp
     :reader errhp
     :initarg :errhp

-    :type (alien (* (* t)))
+    :type pointer-pointer-void

     :documentation
     "OCI error handle")
    (svchp
     :reader svchp
     :initarg :svchp
     :documentation
     "OCI error handle")
    (svchp
     :reader svchp
     :initarg :svchp

-    :type (alien (* (* t)))
+    :type pointer-pointer-void

     :documentation
     "OCI service context handle")
    (data-source-name
     :documentation
     "OCI service context handle")
    (data-source-name


@@ -113,7 +105,19 @@
     "Each database connection can be configured with its own date
 output format.  In order to extract date strings from output buffers
 holding multiple date strings in fixed-width fields, we need to know
     "Each database connection can be configured with its own date
 output format.  In order to extract date strings from output buffers
 holding multiple date strings in fixed-width fields, we need to know

-the length of that format.")))
+the length of that format.")
+   (server-version 
+    :type string
+    :initarg :server-version
+    :reader server-version
+    :documentation
+    "Version string of Oracle server.")
+   (major-version-number
+    :type (or null fixnum)
+    :initarg :major-version-number
+    :reader major-version-number
+    :documentation
+    "The major version number of Oracle, should be 8, 9, or 10")))

 
 
 ;;; Handle the messy case of return code=+oci-error+, querying the
 
 
 ;;; Handle the messy case of return code=+oci-error+, querying the


@@ -123,26 +127,32 @@ the length of that format.")))
 (defun handle-oci-error (&key database nulls-ok)
   (cond (database
          (with-slots (errhp)
 (defun handle-oci-error (&key database nulls-ok)
   (cond (database
          (with-slots (errhp)

-           database
-           (with-alien ((errbuf (array char #.+errbuf-len+))
-                        (errcode (array long 1)))
-             (setf (deref errbuf 0) 0) ; i.e. init to empty string
-             (setf (deref errcode 0) 0)
-             (oci-error-get (deref errhp) 1 "" (c-& errcode 0) (c-& errbuf 0) +errbuf-len+ +oci-htype-error+)
-             (let ((subcode (deref errcode 0)))
+            database
+           (uffi:with-foreign-objects ((errbuf :unsigned-char +errbuf-len+)
+                                      (errcode :long))
+            ;; ensure errbuf empty string
+             (setf (uffi:deref-array errbuf '(:array :unsigned-char) 0)
+                  (uffi:ensure-char-storable (code-char 0)))
+
+             (setf (uffi:deref-pointer errcode :long) 0)
+             (oci-error-get (uffi:deref-pointer errhp void-pointer) 1
+                           (uffi:make-null-pointer :unsigned-char)
+                           errcode errbuf +errbuf-len+ +oci-htype-error+)
+             (let ((subcode (uffi:deref-pointer errcode :long)))

                (unless (and nulls-ok (= subcode +null-value-returned+))
                  (error 'clsql-sql-error
                         :database database
                         :errno subcode
                (unless (and nulls-ok (= subcode +null-value-returned+))
                  (error 'clsql-sql-error
                         :database database
                         :errno subcode

-                        :error (cast (c-& errbuf 0) c-string)))))))
+                       :expression nil
+                        :error (uffi:convert-from-foreign-string errbuf)))))))

        (nulls-ok
         (error 'clsql-sql-error
                 :database database
        (nulls-ok
         (error 'clsql-sql-error
                 :database database

-                :error "can't handle NULLS-OK without ERRHP"))
+                :message "can't handle NULLS-OK without ERRHP"))

        (t 
         (error 'clsql-sql-error
                 :database database
        (t 
         (error 'clsql-sql-error
                 :database database

-                :error "OCI Error (and no ERRHP available to find subcode)"))))
+                :message "OCI Error (and no ERRHP available to find subcode)"))))

 
 ;;; Require an OCI success code.
 ;;;
 
 ;;; Require an OCI success code.
 ;;;


@@ -189,11 +199,16 @@ the length of that format.")))
 ;; In order to map the "same string" property above onto Lisp equality,
 ;; we drop trailing spaces in all cases:
 
 ;; In order to map the "same string" property above onto Lisp equality,
 ;; we drop trailing spaces in all cases:
 

+(uffi:def-type string-pointer (* :unsigned-char))
+

 (defun deref-oci-string (arrayptr string-index size)
 (defun deref-oci-string (arrayptr string-index size)

-  (declare (type (alien (* char)) arrayptr))
+  (declare (type string-pointer arrayptr))

   (declare (type (mod #.+n-buf-rows+) string-index))
   (declare (type (and unsigned-byte fixnum) size))
   (declare (type (mod #.+n-buf-rows+) string-index))
   (declare (type (and unsigned-byte fixnum) size))

-  (let* ((raw (cast (addr (deref arrayptr (* string-index size))) c-string))
+  (let* ((raw (uffi:convert-from-foreign-string 
+              (uffi:make-pointer
+               (+ (uffi:pointer-address arrayptr) (* string-index size))
+               :unsigned-char)))

         (trimmed (string-trim " " raw)))
     (if (equal trimmed "NULL") nil trimmed)))
 
         (trimmed (string-trim " " raw)))
     (if (equal trimmed "NULL") nil trimmed)))
 


@@ -209,15 +224,17 @@ the length of that format.")))
 
 #+nil
 (defun deref-oci-date (arrayptr index)
 
 #+nil
 (defun deref-oci-date (arrayptr index)

-  (oci-date->universal-time (addr (deref arrayptr
-                                        (* index +oci-date-bytes+)))))
+  (oci-date->universal-time (uffi:pointer-address 
+                            (uffi:deref-array arrayptr
+                                              '(:array :unsigned-char)
+                                              (* index +oci-date-bytes+)))))

 #+nil
 (defun oci-date->universal-time (oci-date)
 #+nil
 (defun oci-date->universal-time (oci-date)

-  (declare (type (alien (* char)) oci-date))
+  (declare (type (alien (* :unsigned-char)) oci-date))

   (flet (;; a character from OCI-DATE, interpreted as an unsigned byte
         (ub (i)
           (declare (type (mod #.+oci-date-bytes+) i))
   (flet (;; a character from OCI-DATE, interpreted as an unsigned byte
         (ub (i)
           (declare (type (mod #.+oci-date-bytes+) i))

-          (mod (deref oci-date i) 256)))
+          (mod (uffi:deref-array oci-date string-pointer i) 256)))

     (let* ((century (* (- (ub 0) 100) 100))
           (year    (+ century (- (ub 1) 100)))
           (month   (ub 2))
     (let* ((century (* (- (ub 0) 100) 100))
           (year    (+ century (- (ub 1) 100)))
           (month   (ub 2))


@@ -238,32 +255,30 @@ the length of that format.")))
 ;  (sql:query "select '',OWNER,TABLE_NAME,TABLE_TYPE,'' from all_catalog"))
   
 
 ;  (sql:query "select '',OWNER,TABLE_NAME,TABLE_TYPE,'' from all_catalog"))
   
 

-(defmethod list-all-user-database-tables ((db oracle-database))
-  (unless db
-    (setf db sql:*default-database*))
+(defmethod database-list-tables ((database oracle-database) &key owner)
+  (mapcar #'car 
+         (database-query "select table_name from user_tables"
+                         database nil nil))
+  #+nil

   (values (database-query "select TABLE_NAME from all_catalog
   (values (database-query "select TABLE_NAME from all_catalog

-               where owner <> 'PUBLIC' and owner <> 'SYSTEM' and owner <> 'SYS'"
-                         db)))
+               where owner not in ('PUBLIC','SYSTEM','SYS','WMSYS','EXFSYS','CTXSYS','WKSYS','WK_TEST','MDSYS','DMSYS','OLAPSYS','ORDSYS','XDB')"
+                         db nil nil)))

 
 
 
 

-(defmethod database-list-tables ((database oracle-database)
-                                 &key (system-tables nil))
-  (if system-tables
-      (select [table_name] :from [all_catalog])
-      (select [table_name] :from [all_catalog]
-              :where [and [<> [owner] "PUBLIC"]
-                          [<> [owner] "SYSTEM"]
-                          [<> [owner] "SYS"]]
-              :flatp t)))
+(defmethod database-list-views ((database oracle-database)
+                                 &key owner)
+  ;; (database-query "select table_name from all_catalog" database nil nil)
+  (mapcar #'car
+         (database-query "select view_name from user_views" database nil nil)))

 
 

-;; Return a list of all columns in TABLE.
-;;
-;; The Allegro version of this also returned a second value.
+
+(defmethod database-list-indexes ((database oracle-database)
+                                  &key (owner nil))
+  (mapcar #'car
+         (database-query "select index_name from user_indexes" database nil nil)))

 
 (defmethod list-all-table-columns (table (db oracle-database))
 
 (defmethod list-all-table-columns (table (db oracle-database))

-  (declare (type string table))
-  (unless db
-    (setf db (default-database)))
+  (declare (string table))

   (let* ((sql-stmt (concatenate
                    'simple-string
                    "select "
   (let* ((sql-stmt (concatenate
                    'simple-string
                    "select "


@@ -274,7 +289,7 @@ the length of that format.")))
                    "user_tab_columns.DATA_TYPE from user_tab_columns,"
                    "all_tables where all_tables.table_name = '" table "'"
                    " and user_tab_columns.table_name = '" table "'"))
                    "user_tab_columns.DATA_TYPE from user_tab_columns,"
                    "all_tables where all_tables.table_name = '" table "'"
                    " and user_tab_columns.table_name = '" table "'"))

-        (preresult (sql sql-stmt :db db :types :auto)))
+        (preresult (database-query sql-stmt db :auto nil)))

     ;; PRERESULT is like RESULT except that it has a name instead of
     ;; type codes in the fifth column of each row. To fix this, we
     ;; destructively modify PRERESULT.
     ;; PRERESULT is like RESULT except that it has a name instead of
     ;; type codes in the fifth column of each row. To fix this, we
     ;; destructively modify PRERESULT.


@@ -287,17 +302,14 @@ the length of that format.")))
                1))) ; string
     preresult))
 
                1))) ; string
     preresult))
 

-(defmethod database-list-attributes (table (database oracle-database))
-  (let* ((relname (etypecase table
-                   (sql-sys::sql-ident
-                    (string-upcase
-                     (symbol-name (slot-value table 'sql-sys::name))))
-                   (string table))))
-    (select [user_tab_columns column_name]
-            :from [user_tab_columns]
-            :where [= [user_tab_columns table_name] relname]
-            :flatp t)))

 
 

+(defmethod database-list-attributes (table (database oracle-database) &key owner)
+  (mapcar #'car
+         (database-query
+          (format nil
+                  "select user_tab_columns,column_name from user_tab_columns where user_tab_columns.table_name='~A'"
+                  table)
+          database nil nil))))

 
 
 ;; Return one row of the table referred to by QC, represented as a
 
 
 ;; Return one row of the table referred to by QC, represented as a


@@ -318,11 +330,48 @@ the length of that format.")))
 ;; STREAM which has no more data, and QC is not a STREAM, we signal
 ;; DBI-ERROR instead.
 
 ;; STREAM which has no more data, and QC is not a STREAM, we signal
 ;; DBI-ERROR instead.
 

+(uffi:def-type short-pointer '(* :short))
+(uffi:def-type int-pointer '(* :int))
+(uffi:def-type double-pointer '(* :double))
+
+;;; the result of a database query: a cursor through a table
+(defstruct (oracle-result-set (:print-function print-query-cursor)
+                              (:conc-name qc-)
+                              (:constructor %make-query-cursor))
+  (db (error "missing DB")              ; db conn. this table is associated with
+    :type oracle-database
+    :read-only t)
+  (stmthp (error "missing STMTHP")      ; the statement handle used to create
+;;  :type alien                        ; this table. owned by the QUERY-CURSOR
+    :read-only t)                       ; object, deallocated on CLOSE-QUERY
+  (cds) ;  (error "missing CDS")            ; column descriptors
+;    :type (simple-array cd 1)
+                                       ;    :read-only t)
+  (n-from-oci 
+   0                         ; buffered rows: number of rows recv'd
+   :type (integer 0 #.+n-buf-rows+))   ; from the database on the last read
+  (n-to-dbi
+   0                           ; number of buffered rows returned, i.e.
+   :type (integer 0 #.+n-buf-rows+))   ; the index, within the buffered rows,
+                                        ; of the next row which hasn't already
+                                        ; been returned
+  (total-n-from-oci
+   0                   ; total number of bytes recv'd from OCI
+   :type unsigned-byte)                ; in all reads
+  (oci-end-seen-p nil))                 ; Have we seen the end of OCI
+                                        ; data, i.e. OCI returning
+                                        ; less data than we requested?
+                                        ; OCI doesn't seem to like us
+                                        ; to try to read more data
+                                        ; from it after that..
+
+

 (defun fetch-row (qc &optional (eof-errorp t) eof-value)
 (defun fetch-row (qc &optional (eof-errorp t) eof-value)

-  (declare (optimize (speed 3)))
+  ;;(declare (optimize (speed 3)))

   (cond ((zerop (qc-n-from-oci qc))
         (if eof-errorp
   (cond ((zerop (qc-n-from-oci qc))
         (if eof-errorp

-            (dbi-error "no more rows available in ~S" qc)
+            (error 'clsql-error :message
+                   (format nil "no more rows available in ~S" qc))

           eof-value))
        ((>= (qc-n-to-dbi qc)
             (qc-n-from-oci qc))
           eof-value))
        ((>= (qc-n-to-dbi qc)
             (qc-n-from-oci qc))


@@ -334,47 +383,57 @@ the length of that format.")))
               (irow (qc-n-to-dbi qc)))
           (dotimes (icd (length cds))
             (let* ((cd (aref cds icd))
               (irow (qc-n-to-dbi qc)))
           (dotimes (icd (length cds))
             (let* ((cd (aref cds icd))

-                   (b (alien-resource-buffer (cd-buffer cd)))
+                   (b (foreign-resource-buffer (cd-buffer cd)))

                    (value
                    (value

-                    (let ((arb (alien-resource-buffer (cd-indicators cd))))
-                      (declare (type (alien (* (alien:signed 16))) arb))
-                      (unless (= (deref arb irow) -1)
+                    (let ((arb (foreign-resource-buffer (cd-indicators cd))))
+                      (declare (type int-pointer arb))
+                      (unless (= (uffi:deref-array arb '(:array :int) irow) -1)

                         (ecase (cd-oci-data-type cd)
                         (ecase (cd-oci-data-type cd)

-                          (#.SQLT-STR  (deref-oci-string b irow (cd-sizeof cd)))
-                          (#.SQLT-FLT  (deref (the (alien (* double)) b) irow))
-                          (#.SQLT-INT  (deref (the (alien (* int)) b) irow))
-                          (#.SQLT-DATE (deref-oci-string b irow (cd-sizeof cd))))))))
+                          (#.SQLT-STR  
+                           (deref-oci-string b irow (cd-sizeof cd)))
+                          (#.SQLT-FLT  
+                           (uffi:with-cast-pointer (bd b :double)
+                             (uffi:deref-array bd '(:array :double) irow)))
+                          (#.SQLT-INT  
+                           (uffi:with-cast-pointer (bi b :int)
+                             (uffi:deref-array bi '(:array :int) irow)))
+                          (#.SQLT-DATE 
+                           (deref-oci-string b irow (cd-sizeof cd))))))))

               (push value reversed-result)))
           (incf (qc-n-to-dbi qc))
           (nreverse reversed-result)))))
 
 (defun refill-qc-buffers (qc)
               (push value reversed-result)))
           (incf (qc-n-to-dbi qc))
           (nreverse reversed-result)))))
 
 (defun refill-qc-buffers (qc)

-  (with-slots (errhp)
-    (qc-db qc)
+  (with-slots (errhp) (qc-db qc)

     (setf (qc-n-to-dbi qc) 0)
     (cond ((qc-oci-end-seen-p qc)
            (setf (qc-n-from-oci qc) 0))
           (t
     (setf (qc-n-to-dbi qc) 0)
     (cond ((qc-oci-end-seen-p qc)
            (setf (qc-n-from-oci qc) 0))
           (t

-           (let ((oci-code (%oci-stmt-fetch (deref (qc-stmthp qc))
-                                           (deref errhp)
-                                           +n-buf-rows+
-                                           +oci-fetch-next+ +oci-default+)))
+           (let ((oci-code (%oci-stmt-fetch 
+                           (uffi:deref-pointer (qc-stmthp qc) void-pointer)
+                           (uffi:deref-pointer errhp void-pointer)
+                           +n-buf-rows+
+                           +oci-fetch-next+ +oci-default+)))

              (ecase oci-code
                (#.+oci-success+ (values))
                (#.+oci-no-data+ (setf (qc-oci-end-seen-p qc) t)
                                 (values))
                (#.+oci-error+ (handle-oci-error :database (qc-db qc)
                                                 :nulls-ok t))))
              (ecase oci-code
                (#.+oci-success+ (values))
                (#.+oci-no-data+ (setf (qc-oci-end-seen-p qc) t)
                                 (values))
                (#.+oci-error+ (handle-oci-error :database (qc-db qc)
                                                 :nulls-ok t))))

-           (with-alien ((rowcount (array unsigned-long 1)))
-             (oci-attr-get (deref (qc-stmthp qc)) +oci-htype-stmt+
-                           (c-& rowcount 0) nil +oci-attr-row-count+ 
-                           (deref errhp))
+           (uffi:with-foreign-object (rowcount :long)
+             (oci-attr-get (uffi:deref-pointer (qc-stmthp qc) void-pointer)
+                          +oci-htype-stmt+
+                           rowcount 
+                          (uffi:make-null-pointer :unsigned-long)
+                          +oci-attr-row-count+ 
+                           (uffi:deref-pointer errhp void-pointer))

              (setf (qc-n-from-oci qc)
              (setf (qc-n-from-oci qc)

-                   (- (deref rowcount 0) (qc-total-n-from-oci qc)))
+                   (- (uffi:deref-pointer rowcount :long)
+                     (qc-total-n-from-oci qc)))

              (when (< (qc-n-from-oci qc) +n-buf-rows+)
                (setf (qc-oci-end-seen-p qc) t))
              (setf (qc-total-n-from-oci qc)
              (when (< (qc-n-from-oci qc) +n-buf-rows+)
                (setf (qc-oci-end-seen-p qc) t))
              (setf (qc-total-n-from-oci qc)

-                   (deref rowcount 0)))))
+                   (uffi:deref-pointer rowcount :long)))))

     (values)))
 
 ;; the guts of the SQL function
     (values)))
 
 ;; the guts of the SQL function


@@ -395,25 +454,36 @@ the length of that format.")))
 (defun sql-stmt-exec (sql-stmt-string db &key types)
   (with-slots (envhp svchp errhp)
     db
 (defun sql-stmt-exec (sql-stmt-string db &key types)
   (with-slots (envhp svchp errhp)
     db

-    (let ((stmthp (make-alien (* t))))
-      (with-alien ((stmttype (array unsigned-short 1)))
+    (let ((stmthp (uffi:allocate-foreign-object void-pointer)))
+      (uffi:with-foreign-object (stmttype :unsigned-short)

         
         

-        (oci-handle-alloc (deref envhp) (c-& stmthp) +oci-htype-stmt+ 0 nil)
-        (oci-stmt-prepare (deref stmthp) (deref errhp)
-                          sql-stmt-string (length sql-stmt-string)
+        (oci-handle-alloc (uffi:deref-pointer envhp void-pointer)
+                         stmthp
+                         +oci-htype-stmt+ 0 +null-void-pointer-pointer+)
+        (oci-stmt-prepare (uffi:deref-pointer stmthp void-pointer)
+                         (uffi:deref-pointer errhp void-pointer)
+                          (uffi:convert-to-cstring sql-stmt-string)
+                         (length sql-stmt-string)

                           +oci-ntv-syntax+ +oci-default+ :database db)
                           +oci-ntv-syntax+ +oci-default+ :database db)

-        (oci-attr-get (deref stmthp) +oci-htype-stmt+ 
-                      (c-& stmttype 0) nil +oci-attr-stmt-type+ 
-                      (deref errhp) :database db)
-        (let* ((select-p (= (deref stmttype 0) 1)) 
+        (oci-attr-get (uffi:deref-pointer stmthp void-pointer) 
+                     +oci-htype-stmt+ 
+                      stmttype
+                     (uffi:make-null-pointer :unsigned-int)
+                     +oci-attr-stmt-type+ 
+                      (uffi:deref-pointer errhp void-pointer)
+                     :database db)
+        (let* ((select-p (= (uffi:deref-pointer stmttype :unsigned-short) 1)) 

                (iters (if select-p 0 1)))
           
                (iters (if select-p 0 1)))
           

-          (oci-stmt-execute (deref svchp) (deref stmthp) (deref errhp)
-                            iters 0 nil nil +oci-default+ :database db)
+          (oci-stmt-execute (uffi:deref-pointer svchp void-pointer)
+                           (uffi:deref-pointer stmthp void-pointer)
+                           (uffi:deref-pointer errhp void-pointer)
+                            iters 0 +null-void-pointer+ +null-void-pointer+ +oci-default+
+                           :database db)

           (cond (select-p
                  (make-query-cursor db stmthp types))
                 (t
           (cond (select-p
                  (make-query-cursor db stmthp types))
                 (t

-                 (oci-handle-free (deref stmthp) +oci-htype-stmt+)
+                 (oci-handle-free (uffi:deref-pointer stmthp void-pointer) +oci-htype-stmt+)

                  nil)))))))
 
 
                  nil)))))))
 
 


@@ -492,89 +562,101 @@ the length of that format.")))
             
 
 (defun make-query-cursor-cds (database stmthp types)
             
 
 (defun make-query-cursor-cds (database stmthp types)

-  (declare (optimize (speed 3))
+  (declare (optimize (safety 3) #+nil (speed 3))

           (type oracle-database database)
           (type oracle-database database)

-          (type (alien (* (* t))) stmthp))
+          (type pointer-pointer-void stmthp))

   (with-slots (errhp)
     database
     (unless (eq types :auto)
       (error "unsupported TYPES value"))
   (with-slots (errhp)
     database
     (unless (eq types :auto)
       (error "unsupported TYPES value"))

-    (with-alien ((dtype unsigned-short 1)
-                 (parmdp (* t))
-                 (precision (unsigned 8))
-                 (scale (signed 8))
-                 (colname c-string)
-                 (colnamelen unsigned-long)
-                 (colsize unsigned-long)
-                 (colsizesize unsigned-long)
-                 (defnp (* t)))
+    (uffi:with-foreign-objects ((dtype-foreign :unsigned-short)
+                          (parmdp ':pointer-void)
+                          (precision :byte)
+                          (scale :byte)
+                          (colname '(* :unsigned-char))
+                          (colnamelen :unsigned-long)
+                          (colsize :unsigned-long)
+                          (colsizesize :unsigned-long)
+                          (defnp ':pointer-void))

       (let ((buffer nil)
            (sizeof nil))
        (do ((icolumn 0 (1+ icolumn))
             (cds-as-reversed-list nil))
       (let ((buffer nil)
            (sizeof nil))
        (do ((icolumn 0 (1+ icolumn))
             (cds-as-reversed-list nil))

-           ((not (eql (oci-param-get (deref stmthp) +oci-htype-stmt+
-                                     (deref errhp) (addr parmdp)
+           ((not (eql (oci-param-get (uffi:deref-pointer stmthp void-pointer) 
+                                     +oci-htype-stmt+
+                                     (uffi:deref-pointer errhp void-pointer)
+                                     parmdp

                                      (1+ icolumn) :database database)
                       +oci-success+))
             (coerce (reverse cds-as-reversed-list) 'simple-vector))
          ;; Decode type of ICOLUMNth column into a type we're prepared to
          ;; handle in Lisp.
                                      (1+ icolumn) :database database)
                       +oci-success+))
             (coerce (reverse cds-as-reversed-list) 'simple-vector))
          ;; Decode type of ICOLUMNth column into a type we're prepared to
          ;; handle in Lisp.

-         (oci-attr-get parmdp +oci-dtype-param+ (addr dtype)
-                       nil +oci-attr-data-type+ (deref errhp))
-         (case dtype
-           (#.SQLT-DATE
-            (setf buffer (acquire-alien-resource char (* 32 +n-buf-rows+)))
-            (setf sizeof 32 dtype #.SQLT-STR))
-           (2 ;; number
-            ;;(oci-attr-get parmdp +oci-dtype-param+
-            ;;(addr precision) nil +oci-attr-precision+
-            ;;(deref errhp))
-            (oci-attr-get parmdp +oci-dtype-param+
-                          (addr scale) nil +oci-attr-scale+
-                          (deref errhp))
-            (cond
-             ((zerop scale)
-              (setf buffer (acquire-alien-resource signed +n-buf-rows+)
-                    sizeof 4                   ;; sizeof(int)
-                    dtype #.SQLT-INT))
-             (t
-              (setf buffer (acquire-alien-resource double-float +n-buf-rows+)
-                    sizeof 8                   ;; sizeof(double)
-                    dtype #.SQLT-FLT))))          
-           (t  ; Default to SQL-STR
-            (setf colsize 0
-                  dtype #.SQLT-STR)
-            (oci-attr-get parmdp +oci-dtype-param+ (addr colsize)
-                          (addr colsizesize) +oci-attr-data-size+
-                          (deref errhp))
-            (let ((colsize-including-null (1+ colsize)))
-              (setf buffer (acquire-alien-resource char (* +n-buf-rows+ colsize-including-null)))
-              (setf sizeof colsize-including-null))))
-         (let ((retcodes (acquire-alien-resource short +n-buf-rows+))
-               (indicators (acquire-alien-resource short +n-buf-rows+)))
-           (push (make-cd :name "col" ;(subseq colname 0 colnamelen)
-                          :sizeof sizeof
-                          :buffer buffer
-                          :oci-data-type dtype
-                          :retcodes retcodes
-                          :indicators indicators)
-                 cds-as-reversed-list)
-           (oci-define-by-pos (deref stmthp)
-                              (addr defnp)
-                              (deref errhp)
-                              (1+ icolumn) ; OCI 1-based indexing again
-                              (alien-resource-buffer buffer)
-                              sizeof
-                              dtype
-                              (alien-resource-buffer indicators)
-                              nil
-                              (alien-resource-buffer retcodes)
-                              +oci-default+)))))))
-
+         (oci-attr-get (uffi:deref-pointer parmdp void-pointer)
+                       +oci-dtype-param+ 
+                       dtype-foreign
+                       (uffi:make-null-pointer :int) +oci-attr-data-type+
+                       (uffi:deref-pointer errhp void-pointer))
+         (let ((dtype (uffi:deref-pointer dtype-foreign :unsigned-short)))
+           (case dtype
+             (#.SQLT-DATE
+              (setf buffer (acquire-foreign-resource :char (* 32 +n-buf-rows+)))
+              (setf sizeof 32 dtype #.SQLT-STR))
+             (2 ;; number
+              ;;(oci-attr-get parmdp +oci-dtype-param+
+              ;;(addr precision) nil +oci-attr-precision+
+              ;;(uffi:deref-pointer errhp))
+              (oci-attr-get (uffi:deref-pointer parmdp void-pointer)
+                            +oci-dtype-param+
+                            scale
+                            (uffi:make-null-pointer :int) +oci-attr-scale+
+                            (uffi:deref-pointer errhp void-pointer))
+              (cond
+               ((zerop (uffi:deref-pointer scale :byte))
+                (setf buffer (acquire-foreign-resource :init +n-buf-rows+)
+                      sizeof 4                 ;; sizeof(int)
+                      dtype #.SQLT-INT))
+               (t
+                (setf buffer (acquire-foreign-resource :double +n-buf-rows+)
+                      sizeof 8                   ;; sizeof(double)
+                      dtype #.SQLT-FLT))))          
+             (t                        ; Default to SQL-STR
+              (setf (uffi:deref-pointer colsize :unsigned-long) 0
+                    dtype #.SQLT-STR)
+              (oci-attr-get (uffi:deref-pointer parmdp void-pointer)
+                            +oci-dtype-param+ 
+                            colsize
+                            (uffi:make-null-pointer :int) ;;  (uffi:pointer-address colsizesize) 
+                            +oci-attr-data-size+
+                            (uffi:deref-pointer errhp void-pointer))
+              (let ((colsize-including-null (1+ (uffi:deref-pointer colsize :unsigned-long))))
+                (setf buffer (acquire-foreign-resource
+                              :char (* +n-buf-rows+ colsize-including-null)))
+                (setf sizeof colsize-including-null))))
+           (let ((retcodes (acquire-foreign-resource :short +n-buf-rows+))
+                 (indicators (acquire-foreign-resource :short +n-buf-rows+)))
+             (push (make-cd :name "col" ;(subseq colname 0 colnamelen)
+                            :sizeof sizeof
+                            :buffer buffer
+                            :oci-data-type dtype
+                            :retcodes retcodes
+                            :indicators indicators)
+                   cds-as-reversed-list)
+             (oci-define-by-pos (uffi:deref-pointer stmthp void-pointer)
+                                defnp
+                                (uffi:deref-pointer errhp void-pointer)
+                                (1+ icolumn) ; OCI 1-based indexing again
+                                (foreign-resource-buffer buffer)
+                                sizeof
+                                dtype
+                                (foreign-resource-buffer indicators)
+                                (uffi:make-null-pointer :unsigned-short)
+                                (foreign-resource-buffer retcodes)
+                                +oci-default+))))))))
+  

 ;; Release the resources associated with a QUERY-CURSOR.
 
 (defun close-query (qc)
 ;; Release the resources associated with a QUERY-CURSOR.
 
 (defun close-query (qc)

-  (oci-handle-free (deref (qc-stmthp qc)) +oci-htype-stmt+)
+  (oci-handle-free (uffi:deref-pointer (qc-stmthp qc) void-pointer) +oci-htype-stmt+)

   (let ((cds (qc-cds qc)))
     (dotimes (i (length cds))
       (release-cd-resources (aref cds i))))
   (let ((cds (qc-cds qc)))
     (dotimes (i (length cds))
       (release-cd-resources (aref cds i))))


@@ -584,87 +666,114 @@ the length of that format.")))
 ;; Release the resources associated with a column description.
 
 (defun release-cd-resources (cd)
 ;; Release the resources associated with a column description.
 
 (defun release-cd-resources (cd)

-  (free-alien-resource (cd-buffer cd))
-  (free-alien-resource (cd-retcodes cd))
-  (free-alien-resource (cd-indicators cd))
+  (free-foreign-resource (cd-buffer cd))
+  (free-foreign-resource (cd-retcodes cd))
+  (free-foreign-resource (cd-indicators cd))

   (values))
 
 
   (values))
 
 

-(defmethod print-object ((db oracle-database) stream)
-  (print-unreadable-object (db stream :type t :identity t)
-    (format stream "\"/~a/~a\""
-            (slot-value db 'data-source-name)
-            (slot-value db 'user))))
-
-

 (defmethod database-name-from-spec (connection-spec (database-type (eql :oracle)))
 (defmethod database-name-from-spec (connection-spec (database-type (eql :oracle)))

-  (check-connection-spec connection-spec database-type (user password dsn))
-  (destructuring-bind (user password dsn)
-      connection-spec
+  (check-connection-spec connection-spec database-type (dsn user password))
+  (destructuring-bind (dsn user password) connection-spec

     (declare (ignore password))
     (declare (ignore password))

-    (concatenate 'string "/" dsn "/" user)))
+    (concatenate 'string  dsn "/" user)))

 
 
 (defmethod database-connect (connection-spec (database-type (eql :oracle)))
 
 
 (defmethod database-connect (connection-spec (database-type (eql :oracle)))

-  (check-connection-spec connection-spec database-type (user password dsn))
-  (destructuring-bind (user password data-source-name)
+  (check-connection-spec connection-spec database-type (dsn user password))
+  (destructuring-bind (data-source-name user password)

       connection-spec
       connection-spec

-    (let ((envhp (make-alien (* t)))
-          (errhp (make-alien (* t)))
-          (svchp (make-alien (* t)))
-          (srvhp (make-alien (* t))))
+    (let ((envhp (uffi:allocate-foreign-object :pointer-void))
+          (errhp (uffi:allocate-foreign-object :pointer-void))
+          (svchp (uffi:allocate-foreign-object :pointer-void))
+          (srvhp (uffi:allocate-foreign-object :pointer-void)))

       ;; Requests to allocate environments and handles should never
       ;; fail in normal operation, and they're done too early to
       ;; handle errors very gracefully (since they're part of the
       ;; error-handling mechanism themselves) so we just assert they
       ;; work.
       ;; Requests to allocate environments and handles should never
       ;; fail in normal operation, and they're done too early to
       ;; handle errors very gracefully (since they're part of the
       ;; error-handling mechanism themselves) so we just assert they
       ;; work.

-      (setf (deref envhp) nil)
+      (setf (uffi:deref-pointer envhp void-pointer) +null-void-pointer+)

       #+oci-8-1-5
       (progn
       #+oci-8-1-5
       (progn

-        (oci-env-create (c-& envhp) +oci-default+ nil nil nil nil 0 nil)
-       (oci-handle-alloc (deref envhp) (c-& errhp) +oci-htype-error+ 0 nil))
+        (oci-env-create envhp +oci-default+  +null-void-pointer+
+                       +null-void-pointer+  +null-void-pointer+ 
+                       +null-void-pointer+ 0 +null-void-pointer-pointer+)
+       (oci-handle-alloc envhp
+                         (c-& errhp void-pointer) +oci-htype-error+ 0 
+                         +null-void-pointer-pointer+))

       #-oci-8-1-5
       (progn
       #-oci-8-1-5
       (progn

-       (oci-initialize +oci-object+ nil nil nil nil)
-        (ignore-errors (oci-handle-alloc nil (c-& envhp) +oci-htype-env+ 0 nil)) ;no testing return
-        (oci-env-init (c-& envhp) +oci-default+ 0 nil)
-        (oci-handle-alloc (deref envhp) (c-& errhp) +oci-htype-error+ 0 nil)
-        (oci-handle-alloc (deref envhp) (c-& srvhp) +oci-htype-server+ 0 nil)
-        ;;(osucc (oci-server-attach srvhp errhp nil 0 +oci-default+))
-        (oci-handle-alloc (deref envhp) (c-& svchp) +oci-htype-svcctx+ 0 nil)
+       (oci-initialize +oci-object+ +null-void-pointer+ +null-void-pointer+
+                       +null-void-pointer+ +null-void-pointer-pointer+)
+        (ignore-errors (oci-handle-alloc +null-void-pointer+ envhp
+                                        +oci-htype-env+ 0
+                                        +null-void-pointer-pointer+)) ;no testing return
+        (oci-env-init envhp +oci-default+ 0 +null-void-pointer-pointer+)
+        (oci-handle-alloc (uffi:deref-pointer envhp void-pointer) errhp
+                         +oci-htype-error+ 0 +null-void-pointer-pointer+)
+        (oci-handle-alloc (uffi:deref-pointer envhp void-pointer) srvhp
+                         +oci-htype-server+ 0 +null-void-pointer-pointer+)
+       (oci-server-attach (uffi:deref-pointer srvhp void-pointer)
+                          (uffi:deref-pointer errhp void-pointer)
+                          (uffi:make-null-pointer :unsigned-char)
+                          0 +oci-default+)
+        (oci-handle-alloc (uffi:deref-pointer envhp void-pointer) svchp
+                         +oci-htype-svcctx+ 0 +null-void-pointer-pointer+)
+        (oci-attr-set (uffi:deref-pointer svchp void-pointer)
+                     +oci-htype-svcctx+
+                     (uffi:deref-pointer srvhp void-pointer) 0 +oci-attr-server+ 
+                     (uffi:deref-pointer errhp void-pointer))

         ;; oci-handle-alloc((dvoid *)encvhp, (dvoid **)&stmthp, OCI_HTYPE_STMT, 0, 0);
         ;; oci-handle-alloc((dvoid *)encvhp, (dvoid **)&stmthp, OCI_HTYPE_STMT, 0, 0);

-        #+nil
-        (oci-attr-set (deref svchp) +oci-htype-svcctx+ (deref srvhp) 0 +oci-attr-server+ errhp)
+        ;;#+nil

        )
        )

-
-      #+nil
-      (format t "Logging in as user '~A' to database ~A~%"
-             user password data-source-name)
-      (oci-logon (deref envhp) (deref errhp) (c-& svchp)
-                user (length user)
-                password (length password)
-                data-source-name (length data-source-name))
-      (let ((db (make-instance 'oracle-database
-                               :name (database-name-from-spec connection-spec
-                                                              database-type)
-                               :envhp envhp
-                               :errhp errhp
-                              :db-type :oracle
-                               :svchp svchp
-                               :dsn data-source-name
-                               :user user)))
-        ;; :date-format-length (1+ (length date-format)))))
-        (sql:execute-command
-         (format nil "alter session set NLS_DATE_FORMAT='~A'"
-                (date-format db)) :database db)
+      (let (db server-version)
+       (uffi:with-foreign-object (buf '(:array :unsigned-char #.+errbuf-len+))
+         (oci-server-version (uffi:deref-pointer svchp void-pointer)
+                             (uffi:deref-pointer errhp void-pointer)
+                             buf +errbuf-len+ +oci-htype-svcctx+)
+         (setf server-version (uffi:convert-from-foreign-string buf)))
+       (setq db (make-instance 'oracle-database
+                               :name (database-name-from-spec connection-spec
+                                                              database-type)
+                               :envhp envhp
+                               :errhp errhp
+                               :database-type :oracle
+                               :svchp svchp
+                               :dsn data-source-name
+                               :user user
+                               :server-version server-version
+                               :major-version-number (major-version-from-string
+                                                      server-version)))
+
+       (oci-logon (uffi:deref-pointer envhp void-pointer)
+                  (uffi:deref-pointer errhp void-pointer) 
+                  svchp
+                  (uffi:convert-to-cstring user) (length user)
+                  (uffi:convert-to-cstring password) (length password)
+                  (uffi:convert-to-cstring data-source-name) (length data-source-name)
+                  :database db)
+       ;; :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)

         db))))
 
 
         db))))
 
 

+(defun major-version-from-string (str)
+  (cond 
+    ((search " 10g " str)
+     10)
+    ((search " 9g " str)
+     10)))
+
+

 ;; Close a database connection.
 
 (defmethod database-disconnect ((database oracle-database))
 ;; Close a database connection.
 
 (defmethod database-disconnect ((database oracle-database))

-  (osucc (oci-logoff (deref (svchp database)) (deref (errhp database))))
-  (osucc (oci-handle-free (deref (envhp database)) +oci-htype-env+))
+  (osucc (oci-logoff (uffi:deref-pointer (svchp database) void-pointer)
+                    (uffi:deref-pointer (errhp database) void-pointer)))
+  (osucc (oci-handle-free (uffi:deref-pointer (envhp database) void-pointer)
+                         +oci-htype-env+))

   ;; Note: It's neither required nor allowed to explicitly deallocate the
   ;; ERRHP handle here, since it's owned by the ENVHP deallocated above,
   ;; and was therefore automatically deallocated at the same time.
   ;; Note: It's neither required nor allowed to explicitly deallocate the
   ;; ERRHP handle here, since it's owned by the ENVHP deallocated above,
   ;; and was therefore automatically deallocated at the same time.


@@ -682,9 +791,9 @@ the length of that format.")))
 ;;; to construct the table. The Allegro version supports several possible
 ;;; values for this argument, but we only support :AUTO.
 
 ;;; to construct the table. The Allegro version supports several possible
 ;;; values for this argument, but we only support :AUTO.
 

-(defmethod database-query (query-expression (database oracle-database))
+(defmethod database-query (query-expression (database oracle-database) result-types field-names)

   (let ((cursor (sql-stmt-exec query-expression database :types :auto)))
   (let ((cursor (sql-stmt-exec query-expression database :types :auto)))

-    (declare (type (or query-cursor null) cursor))
+    ;; (declare (type (or query-cursor null) cursor))

     (if (null cursor) ; No table was returned.
        (values)
       (do ((reversed-result nil))
     (if (null cursor) ; No table was returned.
        (values)
       (do ((reversed-result nil))


@@ -719,12 +828,14 @@ the length of that format.")))
                 ".NEXTVAL FROM dual"
                 ) :database database)))
 
                 ".NEXTVAL FROM dual"
                 ) :database database)))
 

+(defmethod database-list-sequences ((database oracle-database) &key owner)
+  (mapcar #'car (database-query "select sequence_name from user_sequences" 
+                               database nil nil)))

 
 

-(defmethod database-execute-command
-  (sql-expression (database oracle-database))
-  (database-query sql-expression database)
+(defmethod database-execute-command (sql-expression (database oracle-database))
+  (database-query sql-expression database nil nil)

   ;; HACK HACK HACK
   ;; HACK HACK HACK

-  (database-query "commit" database)
+  (database-query "commit" database nil nil)

   t)
 
 
   t)
 
 


@@ -737,16 +848,16 @@ the length of that format.")))
   (sizeof (error "missing SIZE") :type fixnum :read-only t)
   ;; an array of +N-BUF-ROWS+ elements in C representation
   (buffer (error "Missing BUFFER")
   (sizeof (error "missing SIZE") :type fixnum :read-only t)
   ;; an array of +N-BUF-ROWS+ elements in C representation
   (buffer (error "Missing BUFFER")

-         :type alien-resource
+         :type foreign-resource

          :read-only t)
   ;; an array of +N-BUF-ROWS+ OCI return codes in C representation.
   ;; (There must be one return code for every element of every
   ;; row in order to be able to represent nullness.)
   (retcodes (error "Missing RETCODES")
          :read-only t)
   ;; an array of +N-BUF-ROWS+ OCI return codes in C representation.
   ;; (There must be one return code for every element of every
   ;; row in order to be able to represent nullness.)
   (retcodes (error "Missing RETCODES")

-           :type alien-resource
+           :type foreign-resource

            :read-only t)
   (indicators (error "Missing INDICATORS")
            :read-only t)
   (indicators (error "Missing INDICATORS")

-             :type alien-resource
+             :type foreign-resource

              :read-only t)
   ;; the OCI code for the data type of a single element
   (oci-data-type (error "missing OCI-DATA-TYPE")
              :read-only t)
   ;; the OCI code for the data type of a single element
   (oci-data-type (error "missing OCI-DATA-TYPE")


@@ -763,41 +874,15 @@ the length of that format.")))
            (cd-oci-data-type cd)
            (cd-sizeof cd))))
 
            (cd-oci-data-type cd)
            (cd-sizeof cd))))
 

-;;; the result of a database query: a cursor through a table
-(defstruct (oracle-result-set (:print-function print-query-cursor)
-                              (:conc-name "QC-")
-                              (:constructor %make-query-cursor))
-  (db (error "missing DB")              ; db conn. this table is associated with
-    :type db
-    :read-only t)
-  (stmthp (error "missing STMTHP")      ; the statement handle used to create
-    :type alien                         ; this table. owned by the QUERY-CURSOR
-    :read-only t)                       ; object, deallocated on CLOSE-QUERY
-  (cds) ;  (error "missing CDS")            ; column descriptors
-;    :type (simple-array cd 1)
-;    :read-only t)
-  (n-from-oci 0                         ; buffered rows: number of rows recv'd
-    :type (integer 0 #.+n-buf-rows+))   ; from the database on the last read
-  (n-to-dbi 0                           ; number of buffered rows returned, i.e.
-    :type (integer 0 #.+n-buf-rows+))   ; the index, within the buffered rows,
-                                        ; of the next row which hasn't already
-                                        ; been returned
-  (total-n-from-oci 0                   ; total number of bytes recv'd from OCI
-    :type unsigned-byte)                ; in all reads
-  (oci-end-seen-p nil))                 ; Have we seen the end of OCI
-                                        ; data, i.e. OCI returning
-                                        ; less data than we requested?
-                                        ; OCI doesn't seem to like us
-                                        ; to try to read more data
-                                        ; from it after that..
-

 (defun print-query-cursor (qc stream depth)
   (declare (ignore depth))
   (print-unreadable-object (qc stream :type t :identity t)
     (prin1 (qc-db qc) stream)))
 
 
 (defun print-query-cursor (qc stream depth)
   (declare (ignore depth))
   (print-unreadable-object (qc stream :type t :identity t)
     (prin1 (qc-db qc) stream)))
 
 

-(defmethod database-query-result-set (query-expression (database oracle-database) &optional full-set)
+(defmethod database-query-result-set ((query-expression string)
+                                     (database oracle-database) 
+                                     &key full-set result-types)

   )
 
 (defmethod database-dump-result-set (result-set (database oracle-database))
   )
 
 (defmethod database-dump-result-set (result-set (database oracle-database))


@@ -806,29 +891,29 @@ the length of that format.")))
 (defmethod database-store-next-row (result-set (database oracle-database) list)
   )
 
 (defmethod database-store-next-row (result-set (database oracle-database) list)
   )
 

-(defmethod sql-sys::database-start-transaction ((database oracle-database))
+(defmethod clsql-sys::database-start-transaction ((database oracle-database))

   (call-next-method))
 
 ;;(with-slots (svchp errhp) database
   (call-next-method))
 
 ;;(with-slots (svchp errhp) database

-;;    (osucc (oci-trans-start (deref svchp)
-;;                         (deref errhp)
+;;    (osucc (oci-trans-start (uffi:deref-pointer svchp)
+;;                         (uffi:deref-pointer errhp)

 ;;                         60
 ;;                         +oci-trans-new+)))
 ;;  t)
   
 
 ;;                         60
 ;;                         +oci-trans-new+)))
 ;;  t)
   
 

-(defmethod sql-sys::database-commit-transaction ((database oracle-database))
+(defmethod clsql-sys::database-commit-transaction ((database oracle-database))

   (call-next-method)
   (with-slots (svchp errhp) database
   (call-next-method)
   (with-slots (svchp errhp) database

-             (osucc (oci-trans-commit (deref svchp)
-                                      (deref errhp)
+             (osucc (oci-trans-commit (uffi:deref-pointer svchp void-pointer)
+                                      (uffi:deref-pointer errhp void-pointer)

                                       0)))
   t)
 
                                       0)))
   t)
 

-(defmethod sql-sys::database-abort-transaction ((database oracle-database))
+(defmethod clsql-sys::database-abort-transaction ((database oracle-database))

   (call-next-method)
   (call-next-method)

-  (osucc (oci-trans-rollback (deref (svchp database))
-                          (deref (errhp database))
+  (osucc (oci-trans-rollback (uffi:deref-pointer (svchp database) void-pointer)
+                          (uffi:deref-pointer (errhp database) void-pointer)

                           0))
   t)
 
                           0))
   t)
 


@@ -854,3 +939,10 @@ the length of that format.")))
       buf)))
 
 
       buf)))
 
 

+;; Specifications
+
+(defmethod db-type-has-bigint? ((type (eql :oracle)))
+  nil)
+
+(defmethod db-type-has-fancy-math? ((db-type (eql :postgresql)))
+  t)