r9199: fold clsql-base and clsql-base-sys into clsql-base
[clsql.git] / db-odbc / odbc-dbi.lisp
index 853d3fbca1fad267b7fa88ecec5fb773aefbf3ed..4a6107d93c9235f6f4eeb035cd0ac01d4e071d4d 100644 (file)
    #:disconnect
    #:end-transaction
    #:fetch-row
+   #:list-all-data-sources
    #:list-all-database-tables
    #:list-all-table-columns
+   #:list-table-indexes
    #:loop-over-results
    #:prepare-sql
    #:rr-sql
 
 (in-package #:odbc-dbi)
 
+(defgeneric terminate (src))
+(defgeneric db-open-query (src query-expression
+                              &key arglen col-positions result-types width
+                              &allow-other-keys))
+(defgeneric db-fetch-query-results (src &optional count))
+(defgeneric %db-execute (src sql-expression &key &allow-other-keys))
+(defgeneric db-execute-command (src sql-string))
+
+(defgeneric %initialize-query (src arglen col-positions
+                                  &key result-types width))
+
+(defgeneric %read-query-data (src ignore-columns))
+(defgeneric db-map-query (src type function query-exp &key result-types))
+(defgeneric db-prepare-statement (src sql &key parameter-table
+                                     parameter-columns))
+(defgeneric get-odbc-info (src info-type))
+
+
 ;;; SQL Interface
 
 (defclass odbc-db ()
@@ -179,23 +199,44 @@ the query against." ))
             (coerce (column-names query) 'list))))
       (db-close-query query))))
 
+(defun list-table-indexes (table &key db unique hstmt)
+  (declare (ignore hstmt))
+  (let ((query (get-free-query db)))
+    (unwind-protect
+       (progn
+         (with-slots (hstmt) query
+           (unless hstmt
+             (setf hstmt (%new-statement-handle (hdbc db))))
+           (%table-statistics table hstmt :unique unique)
+           (%initialize-query query nil nil)
+           (values
+            (db-fetch-query-results query)
+            (coerce (column-names query) 'list))))
+      (db-close-query query))))
+
 (defun list-all-table-columns (table &key db hstmt)
   (declare (ignore hstmt))
   (db-describe-columns db "" "" table ""))
 
+(defun list-all-data-sources ()
+  (let ((db (make-instance 'odbc-db)))
+    (unless (henv db) ;; has class allocation!
+      (setf (henv db) (%new-environment-handle)))
+    (%list-data-sources (henv db))))
+
 (defun rr-sql (hstmt sql-statement &key db)
   (declare (ignore hstmt sql-statement db))
   (warn "rr-sql not implemented."))
 
 ;;; Mid-level interface
 
-(defmethod db-commit ((database odbc-db))
+(defun db-commit (database)
   (%commit (henv database) (hdbc database)))
 
-(defmethod db-rollback ((database odbc-db))
+(defun db-rollback (database)
   (%rollback (henv database) (hdbc database)))
 
-(defmethod db-cancel-query ((query odbc-query))
+(defun db-cancel-query (query)
   (with-slots (hstmt) query
     (%sql-cancel hstmt)
     (setf (query-active-p query) nil)))
@@ -228,7 +269,7 @@ the query against." ))
       (uffi:free-foreign-object hstmt)) ;; ??
     (%dispose-column-ptrs query)))
 
-(defmethod %dispose-column-ptrs ((query odbc-query))
+(defun %dispose-column-ptrs (query)
   (with-slots (column-data-ptrs column-out-len-ptrs hstmt) query
     (loop for data-ptr across column-data-ptrs
           when data-ptr do (uffi:free-foreign-object data-ptr))
@@ -283,7 +324,7 @@ the query against." ))
                                                        out-len-ptr result-type))))))))
        (values rows query rows-fetched)))))
 
-(defmethod db-query ((database odbc-db) query-expression &key result-types width)
+(defun db-query (database query-expression &key result-types width)
   (let ((free-query (get-free-query database)))
     (setf (sql-expression free-query) query-expression)
     (unwind-protect
@@ -293,7 +334,7 @@ the query against." ))
        (if (plusp (column-count free-query)) ;; KMR: Added check for commands that don't return columns
            (values
             (db-fetch-query-results free-query nil)
-            (column-names free-query))
+            (map 'list #'identity (column-names free-query)))
          (values
           (result-rows-count (hstmt free-query))
           nil)))
@@ -312,11 +353,11 @@ the query against." ))
       query)))
 
 ;; reuse inactive queries
-(defmethod get-free-query ((database odbc-db))
+(defun get-free-query (database)
   "get-free-query finds or makes a nonactive query object, and then sets it to active.
 This makes the functions db-execute-command and db-query thread safe."
   (with-slots (queries hdbc) database
-    (or (clsql-base-sys:without-interrupts
+    (or (clsql-base:without-interrupts
          (let ((inactive-query (find-if (lambda (query)
                                           (not (query-active-p query)))
                                         queries)))
@@ -419,7 +460,7 @@ This makes the functions db-execute-command and db-query thread safe."
          t)))))
   query)
 
-(defmethod db-close-query ((query odbc-query) &key drop-p)
+(defun db-close-query (query &key drop-p)
   (with-slots (hstmt column-count column-names column-c-types column-sql-types
                      column-data-ptrs column-out-len-ptrs column-precisions
                      column-scales column-nullables-p) query
@@ -428,8 +469,10 @@ This makes the functions db-execute-command and db-query thread safe."
         (dotimes (col-nr count)
           (let ((data-ptr (aref column-data-ptrs col-nr))
                 (out-len-ptr (aref column-out-len-ptrs col-nr)))
-            (when data-ptr (uffi:free-foreign-object data-ptr)) ; we *did* allocate them
-            (when out-len-ptr (uffi:free-foreign-object out-len-ptr)))))
+           (declare (ignorable data-ptr out-len-ptr))
+           ;; free-statment :unbind frees these
+           #+ignore (when data-ptr (uffi:free-foreign-object data-ptr))
+           #+ignore (when out-len-ptr (uffi:free-foreign-object out-len-ptr)))))
       (cond ((null hstmt)
              nil)
             (drop-p
@@ -450,7 +493,7 @@ This makes the functions db-execute-command and db-query thread safe."
               column-data-ptrs column-out-len-ptrs column-precisions
               computed-result-types)
       query
-    (unless (= (SQLFetch hstmt) odbc::$SQL_NO_DATA_FOUND)
+    (unless (= (odbc::SQLFetch hstmt) odbc::$SQL_NO_DATA_FOUND)
       (values
        (loop for col-nr from 0 to (- column-count 
                                      (if (eq ignore-columns :last) 2 1))
@@ -492,8 +535,8 @@ This makes the functions db-execute-command and db-query thread safe."
     ;; dispose of memory and set query inactive or get rid of it
     (db-close-query query)))
 
-(defmethod db-map-bind-query ((query odbc-query) type function 
-                                 &rest parameters)
+(defun db-map-bind-query (query type function 
+                         &rest parameters)
   (declare (ignore type)) ; preliminary. Do a type coersion here
   (unwind-protect
     (progn
@@ -551,7 +594,7 @@ This makes the functions db-execute-command and db-query thread safe."
   query)
 
 
-(defmethod %db-bind-execute ((query odbc-query) &rest parameters)
+(defun %db-bind-execute (query &rest parameters)
   (with-slots (hstmt parameter-data-ptrs) query
     (loop for parameter in parameters
           with data-ptr and size and parameter-string
@@ -581,7 +624,7 @@ This makes the functions db-execute-command and db-query thread safe."
         (%sql-execute hstmt)))
 
 
-(defmethod %db-reset-query ((query odbc-query))
+(defun %db-reset-query (query)
   (with-slots (hstmt parameter-data-ptrs) query
     (prog1
       (db-fetch-query-results query nil) 
@@ -602,8 +645,8 @@ This makes the functions db-execute-command and db-query thread safe."
 
 ;; database inquiery functions
 
-(defmethod db-describe-columns ((database odbc-db) 
-                                    table-qualifier table-owner table-name column-name)
+(defun db-describe-columns (database table-qualifier table-owner 
+                           table-name column-name)
   (with-slots (hdbc) database
     (%describe-columns hdbc table-qualifier table-owner table-name column-name)))
 
@@ -618,7 +661,9 @@ This makes the functions db-execute-command and db-query thread safe."
 (defmethod get-odbc-info ((query odbc-query) info-type)
   (get-odbc-info (odbc::query-database query) info-type))
 
-;; driver inquiery
+;; driver inquiry
+;; How does this differ from list-data-sources?
+(defgeneric db-data-sources (db-type))
 (defmethod db-data-sources ((db-type (eql :odbc)))
    "Returns a list of (data-source description) - pairs"
    (let ((henv (%new-environment-handle)))
@@ -630,5 +675,3 @@ This makes the functions db-execute-command and db-query thread safe."
                collect data-source+description
                do (setf direction :next))
       (%sql-free-environment henv))))
-
-; EOF