From 53d82f855034e08c128c1f29ac905c0897a01480 Mon Sep 17 00:00:00 2001
From: "Kevin M. Rosenberg" <kevin@rosenberg.net>
Date: Mon, 19 Apr 2004 09:01:49 +0000
Subject: [PATCH] r9089: Automated commit for Debian build of clsql
 upstream-version-2.8.1

---
 ChangeLog                      |  5 +++++
 db-odbc/odbc-api.lisp          | 31 +++++++++++++++++++++++++++++++
 db-odbc/odbc-dbi.lisp          |  7 +++++++
 db-odbc/odbc-ff-interface.lisp |  4 ++--
 db-odbc/odbc-package.lisp      |  1 +
 db-odbc/odbc-sql.lisp          |  8 +++++++-
 debian/changelog               |  6 ++++++
 7 files changed, 59 insertions(+), 3 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 432282e..f96cb01 100644
--- 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 a15d628..c032fd3 100644
--- 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 9ebbaad..8aa0b07 100644
--- 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 084a97f..fa46667 100644
--- 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 e70debe..3c22c8b 100644
--- 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 43bcfbb..3bc5368 100644
--- 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 330baa7..bc1f5b6 100644
--- 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
-- 
2.34.1