r9089: Automated commit for Debian build of clsql upstream-version-2.8.1

diff --git a/ChangeLog b/ChangeLog
index 432282e3c46a623d1089cc782e4edd9ede0ad56e..f96cb01adb30bd8d88549dd1cfd084808d863cf2 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+19 Apr 2004 Kevin Rosenberg (kevin@rosenberg.net)
+       * Version 2.8.1
+       * db-odbc/odbc-sql.lisp: Add DATABASE-LIST function 
+       * db-odbc/odbc-dbi.lisp: Add LIST-ALL-DATA-SOURCES function 
+
 19 Apr 2004 Kevin Rosenberg (kevin@rosenberg.net)
        * Version 2.8.0: New API function: LIST-DATABASES
        * base/utils.lisp: Fix command-output on CMUCL/SBCL

diff --git a/db-odbc/odbc-api.lisp b/db-odbc/odbc-api.lisp
index a15d628f8c3c82120ed7cbf7e91f00ba5f6465b2..c032fd3ce6fd7ee6c9295444d1b1afc9be4756c6 100644 (file)
--- a/db-odbc/odbc-api.lisp
+++ b/db-odbc/odbc-api.lisp
@@ -939,3 +939,34 @@ as possible second argument) to the desired representation of date/time/timestam
 (defun %list-tables (hstmt)
   (with-error-handling (:hstmt hstmt)
     (SQLTables hstmt +null-ptr+ 0 +null-ptr+ 0 +null-ptr+ 0 +null-ptr+ 0)))
+
+(defun %list-data-sources (henv)
+  (let ((dsn (allocate-foreign-string (1+ $SQL_MAX_DSN_LENGTH)))
+       (desc (allocate-foreign-string 256))
+       (results nil))
+    (unwind-protect
+        (with-foreign-objects ((dsn-len :short)
+                               (desc-len :short))
+          (with-error-handling (:henv henv)
+            (let ((res
+                   (SQLDataSources henv $SQL_FETCH_FIRST dsn
+                                   (1+ $SQL_MAX_DSN_LENGTH)
+                                   dsn-len desc 256 desc-len)))
+              (when (or (eql res $SQL_SUCCESS)
+                        (eql res $SQL_SUCCESS_WITH_INFO))
+                (push (convert-from-foreign-string dsn) results))
+
+              (do ((res (SQLDataSources henv $SQL_FETCH_NEXT dsn
+                                        (1+ $SQL_MAX_DSN_LENGTH)
+                                        dsn-len desc 256 desc-len)
+                        (SQLDataSources henv $SQL_FETCH_NEXT dsn
+                                        (1+ $SQL_MAX_DSN_LENGTH)
+                                        dsn-len desc 256 desc-len)))
+                  ((not (or (eql res $SQL_SUCCESS)
+                            (eql res $SQL_SUCCESS_WITH_INFO))))
+                (push (convert-from-foreign-string dsn) results)))))
+      (progn
+       (free-foreign-object dsn)
+       (free-foreign-object desc)))
+    (nreverse results)))
+               

diff --git a/db-odbc/odbc-dbi.lisp b/db-odbc/odbc-dbi.lisp
index 9ebbaad5bb1499bb03ebbc0c89cff882734c1405..8aa0b07c6faefae5ea4772b167f8f1c9cf039850 100644 (file)
--- a/db-odbc/odbc-dbi.lisp
+++ b/db-odbc/odbc-dbi.lisp
@@ -30,6 +30,7 @@
    #:disconnect
    #:end-transaction
    #:fetch-row
+   #:list-all-data-sources
    #:list-all-database-tables
    #:list-all-table-columns
    #:loop-over-results
@@ -183,6 +184,12 @@ the query against." ))
   (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."))

diff --git a/db-odbc/odbc-ff-interface.lisp b/db-odbc/odbc-ff-interface.lisp
index 084a97fff4a51d488c795c953c0d469072bcc937..fa46667b550bfde891ae1c862803471a6a067c26 100644 (file)
--- a/db-odbc/odbc-ff-interface.lisp
+++ b/db-odbc/odbc-ff-interface.lisp
@@ -306,10 +306,10 @@
      (fDirection :short)
      (*szDSN string-ptr)        ; UCHAR  FAR *szDSN
      (cbDSNMax :short)          ; SWORD       cbDSNMax
-     (*pcbDSN :pointer-void)             ; SWORD      *pcbDSN
+     (*pcbDSN (* :short))             ; SWORD      *pcbDSN
      (*szDescription string-ptr) ; UCHAR     *szDescription
      (cbDescriptionMax :short)  ; SWORD       cbDescriptionMax
-     (*pcbDescription :pointer-void)     ; SWORD      *pcbDescription
+     (*pcbDescription (* :short))     ; SWORD      *pcbDescription
      )
   :module "odbc"
   :returning :short)              ; RETCODE_SQL_API

diff --git a/db-odbc/odbc-package.lisp b/db-odbc/odbc-package.lisp
index e70debe2b5c29c1be675967f65b4dc5afff8b45e..3c22c8ba05ff894794d4b1938c3d31ecae8af940 100644 (file)
--- a/db-odbc/odbc-package.lisp
+++ b/db-odbc/odbc-package.lisp
@@ -63,6 +63,7 @@
      #:result-rows-count
      #:sql-to-c-type
      #:%list-tables
+     #:%list-data-sources
      )
   (:documentation "This is the low-level interface ODBC."))
 

diff --git a/db-odbc/odbc-sql.lisp b/db-odbc/odbc-sql.lisp
index 43bcfbb7b64b43453997f414b1b7a522e61dd554..3bc5368594f287d733391ffd734c9a833b850b6c 100644 (file)
--- a/db-odbc/odbc-sql.lisp
+++ b/db-odbc/odbc-sql.lisp
@@ -271,7 +271,13 @@
   (warn "Not implemented."))
 
 (defmethod database-probe (connection-spec (type (eql :odbc)))
-  (warn "Not implemented."))
+  (when (find (car connection-spec) (database-list connection-spec type)
+             :test #'string-equal)
+    t))
+
+(defmethod database-list (connection-spec (type (eql :odbc)))
+  (declare (ignore connection-spec))
+  (odbc-dbi:list-all-data-sources))
 
 #+ignore                      
 (when (clsql-base-sys:database-type-library-loaded :odbc)

diff --git a/debian/changelog b/debian/changelog
index 330baa7ca4695746fb67c08724b41f95e9d5b585..bc1f5b6418a7703fd922ab6e82600142204d6fde 100644 (file)
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,9 @@
+cl-sql (2.8.1-1) unstable; urgency=low
+
+  * New upstream
+
+ -- Kevin M. Rosenberg <kmr@debian.org>  Mon, 19 Apr 2004 03:01:34 -0600
+
 cl-sql (2.8.0-1) unstable; urgency=low
 
   * New upstream