X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=db-odbc%2Fodbc-dbi.lisp;h=447f0409029f2310de02067602323710eb231fe6;hb=967266c94b00f91e5967b8330fe2b9134b0c0447;hp=08a8df693d32f82df2e436be631b7ec6891abe45;hpb=d0f147d0e7d942b379bd7cd472f26b00c33916bc;p=clsql.git

diff --git a/db-odbc/odbc-dbi.lisp b/db-odbc/odbc-dbi.lisp
index 08a8df6..447f040 100644
--- a/db-odbc/odbc-dbi.lisp
+++ b/db-odbc/odbc-dbi.lisp
@@ -30,8 +30,10 @@
    #: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
@@ -110,7 +112,7 @@ the query against." ))
       (setf (henv db) (%new-environment-handle)))
     (setf (hdbc db) (%new-db-connection-handle (henv db)))
     (%sql-connect (hdbc db) data-source-name user password)
-    (setf (db-hstmt db) (%new-statement-handle (hdbc db)))
+    #+ignore (setf (db-hstmt db) (%new-statement-handle (hdbc db)))
     (when (/= (get-odbc-info db odbc::$SQL_TXN_CAPABLE) odbc::$SQL_TC_NONE)
       (if autocommit
 	  (enable-autocommit (hdbc db))
@@ -125,7 +127,8 @@ the query against." ))
 	    (when hstmt 
 	      (%free-statement hstmt :drop)
 	      (setf hstmt nil)))))
-    (%free-statement (db-hstmt database) :drop)
+    (when (db-hstmt database)
+      (%free-statement (db-hstmt database) :drop))
     (%disconnect hdbc)))
 
 
@@ -178,10 +181,31 @@ 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."))
@@ -314,14 +338,14 @@ the query against." ))
 (defmethod get-free-query ((database odbc-db))
   "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) database
+  (with-slots (queries hdbc) database
     (or (clsql-base-sys:without-interrupts
          (let ((inactive-query (find-if (lambda (query)
                                           (not (query-active-p query)))
                                         queries)))
            (when inactive-query 
              (with-slots (column-count column-names column-c-types 
-			  width
+			  width hstmt
 			  column-sql-types column-data-ptrs
 			  column-out-len-ptrs column-precisions
 			  column-scales column-nullables-p)
@@ -330,6 +354,7 @@ This makes the functions db-execute-command and db-query thread safe."
                ;;(%dispose-column-ptrs inactive-query)
                (setf column-count 0
 		     width +max-precision+
+		     ;; KMR hstmt (%new-statement-handle hdbc)
                      (fill-pointer column-names) 0
                      (fill-pointer column-c-types) 0
                      (fill-pointer column-sql-types) 0
@@ -426,8 +451,9 @@ 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)))))
+	    ;; 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