r9088: Automated commit for Debian build of clsql upstream-version-2.8.0

diff --git a/ChangeLog b/ChangeLog
index 7fbde1ebdb5229e74e2c05522489f1ddf78944f9..432282e3c46a623d1089cc782e4edd9ede0ad56e 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,7 +1,9 @@
 19 Apr 2004 Kevin Rosenberg (kevin@rosenberg.net)
-       * Version 2.7.10
+       * Version 2.8.0: New API function: LIST-DATABASES
        * base/utils.lisp: Fix command-output on CMUCL/SBCL
-
+       * db-*/*-sql.lisp: Add new database-list function
+       * base/database.lisp: Add new LIST-DATABASES command
+       
 18 Apr 2004 Kevin Rosenberg (kevin@rosenberg.net)
        * Version 2.7.9
        * db-sqlite/sqlite-sql.lisp: Fix sequence functions.

diff --git a/base/database.lisp b/base/database.lisp
index 1e64fb3588d388c814fc9ad7514ea69f9c2de523..cc26d7119c517449b603ed41b654adeec3594017 100644 (file)
--- a/base/database.lisp
+++ b/base/database.lisp
@@ -246,6 +246,10 @@ of full is NIL."
     (setq connection-spec (string-to-list-connection-spec connection-spec)))
   (database-destroy connection-spec database-type))
 
+(defun list-databases (connection-spec &key database-type)
+  (when (stringp connection-spec)
+    (setq connection-spec (string-to-list-connection-spec connection-spec)))
+  (database-list connection-spec database-type))
 
 (defmacro with-database ((db-var connection-spec &rest connect-args) &body body)
   "Evaluate the body in an environment, where `db-var' is bound to the

diff --git a/base/db-interface.lisp b/base/db-interface.lisp
index fa07af92eddbd39c67e9cc0ae19a232a4edf6374..7c75dd0fa95dd7305c64ef4daff373e4763dd73e 100644 (file)
--- a/base/db-interface.lisp
+++ b/base/db-interface.lisp
@@ -113,10 +113,20 @@ returns nil when result-set is finished."))
    "Creates a database, returns T if successfull or signals an error."))
 
 (defgeneric database-probe (connection-spec type)
+  (:method (spec type)
+    (declare (ignore spec))
+    (warn "database-proe not support for database-type ~A." type))
   (:documentation
    "Probes for the existence of a database, returns T if database found or NIL 
 if not found. May signal an error if unable to communicate with database server."))
 
+(defgeneric database-list (connection-spec type)
+  (:method (spec type)
+    (declare (ignore spec))
+    (warn "database-list not support for database-type ~A." type))
+  (:documentation
+   "Lists all databases found for TYPE. May signal an error if unable to communicate with database server."))
+
 (defgeneric database-destroy (connection-spec database)
   (:documentation "Destroys (drops) a database."))
 

diff --git a/base/package.lisp b/base/package.lisp
index e79dddb2a79c745c1422f478827942a7b83c78e0..03d15444f8aa0f26c7a2100e1c95e6e9da41d7f0 100644 (file)
--- a/base/package.lisp
+++ b/base/package.lisp
@@ -43,6 +43,7 @@
      #:database-create
      #:database-destroy
      #:database-probe
+     #:database-list
      #:database-describe-table
      
      #:database-list-tables
@@ -254,6 +255,7 @@
         #:create-database
         #:destroy-database
         #:probe-database
+        #:list-databases
 
         ;; basic-sql.lisp
         #:query

diff --git a/db-mysql/mysql-sql.lisp b/db-mysql/mysql-sql.lisp
index d04f67138963f0fd3fdfe94e5e6f26d27b20ab9f..ea66f3de3605dd16de43020a31ee458f5fa74f7a 100644 (file)
--- a/db-mysql/mysql-sql.lisp
+++ b/db-mysql/mysql-sql.lisp
@@ -391,15 +391,21 @@
        t))))
 
 (defmethod database-probe (connection-spec (type (eql :mysql)))
+  (when (find (second connection-spec) (database-list connection-spec type)
+             :key #'car :test #'string-equal)
+    t))
+
+(defmethod database-list (connection-spec (type (eql :mysql)))
   (destructuring-bind (host name user password) connection-spec
+    (declare (ignore name))
     (let ((database (database-connect (list host "mysql" user password) type)))
       (unwind-protect
-         (when
-             (find name (database-query "select db from db" 
-                                        database :auto)
-                   :key #'car :test #'string-equal)
-           t)
-       (database-disconnect database)))))
+          (progn
+            (setf (slot-value database 'clsql-base-sys::state) :open)
+            (mapcar #'car (database-query "show databases" database :auto)))
+       (progn
+         (database-disconnect database)
+         (setf (slot-value database 'clsql-base-sys::state) :closed))))))
 
 
 (when (clsql-base-sys:database-type-library-loaded :mysql)

diff --git a/db-postgresql-socket/postgresql-socket-sql.lisp b/db-postgresql-socket/postgresql-socket-sql.lisp
index 1e29c070d6749dfac59dcc88dde53898c397aff0..50c6899afc0f8c6a4a36fefc0597fdb911967663 100644 (file)
--- a/db-postgresql-socket/postgresql-socket-sql.lisp
+++ b/db-postgresql-socket/postgresql-socket-sql.lisp
@@ -446,17 +446,25 @@ doesn't depend on UFFI."
          (execute-command (format nil "drop database ~A" name))
        (database-disconnect database)))))
 
+
 (defmethod database-probe (connection-spec (type (eql :postgresql-socket)))
+  (when (find (second connection-spec) (database-list connection-spec type)
+             :key #'car :test #'string-equal)
+    t))
+
+(defmethod database-list (connection-spec (type (eql :postgresql-socket)))
   (destructuring-bind (host name user password) connection-spec
+    (declare (ignore name))
     (let ((database (database-connect (list host "template1" user password)
                                      type)))
       (unwind-protect
-         (when
-             (find name (database-query "select datname from pg_database" 
-                                        database :auto)
-                   :key #'car :test #'string-equal)
-           t)
-       (database-disconnect database)))))
+          (progn
+            (setf (slot-value database 'clsql-base-sys::state) :open)
+            (mapcar #'car (database-query "select datname from pg_database" 
+                                          database :auto)))
+       (progn
+         (database-disconnect database)
+         (setf (slot-value database 'clsql-base-sys::state) :closed))))))
 
 (defmethod database-describe-table ((database postgresql-socket-database) 
                                    table)

diff --git a/db-postgresql/postgresql-sql.lisp b/db-postgresql/postgresql-sql.lisp
index ae3c18ef936cf097ae5325b929ead2a73dbe14a3..b4eaa821662e0304b0b02c52542b4ef488b7b723 100644 (file)
--- a/db-postgresql/postgresql-sql.lisp
+++ b/db-postgresql/postgresql-sql.lisp
@@ -517,16 +517,23 @@
 
 
 (defmethod database-probe (connection-spec (type (eql :postgresql)))
+  (when (find (second connection-spec) (database-list connection-spec type)
+             :key #'car :test #'string-equal)
+    t))
+
+(defmethod database-list (connection-spec (type (eql :postgresql)))
   (destructuring-bind (host name user password) connection-spec
+    (declare (ignore name))
     (let ((database (database-connect (list host "template1" user password)
                                      type)))
       (unwind-protect
-         (when
-             (find name (database-query "select datname from pg_database" 
-                                        database :auto)
-                   :key #'car :test #'string-equal)
-           t)
-       (database-disconnect database)))))
+          (progn
+            (setf (slot-value database 'clsql-base-sys::state) :open)
+            (mapcar #'car (database-query "select datname from pg_database" 
+                                          database :auto)))
+       (progn
+         (database-disconnect database)
+         (setf (slot-value database 'clsql-base-sys::state) :closed))))))
 
 (defmethod database-describe-table ((database postgresql-database) table)
   (database-query 

diff --git a/debian/changelog b/debian/changelog
index 48ac3b1cb2a20ee733ac302c1699ab03e8728cc3..330baa7ca4695746fb67c08724b41f95e9d5b585 100644 (file)
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,4 +1,4 @@
-cl-sql (2.7.10-1) unstable; urgency=low
+cl-sql (2.8.0-1) unstable; urgency=low
 
   * New upstream