From: Kevin M. Rosenberg Date: Mon, 19 Apr 2004 08:17:17 +0000 (+0000) Subject: r9088: Automated commit for Debian build of clsql upstream-version-2.8.0 X-Git-Tag: v3.8.6~606 X-Git-Url: http://git.kpe.io/?p=clsql.git;a=commitdiff_plain;h=a3e1cd20eec3903790c6e8f126345558904488f4 r9088: Automated commit for Debian build of clsql upstream-version-2.8.0 --- diff --git a/ChangeLog b/ChangeLog index 7fbde1e..432282e 100644 --- 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 1e64fb3..cc26d71 100644 --- 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 fa07af9..7c75dd0 100644 --- 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 e79dddb..03d1544 100644 --- 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 d04f671..ea66f3d 100644 --- 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 1e29c07..50c6899 100644 --- 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 ae3c18e..b4eaa82 100644 --- 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 48ac3b1..330baa7 100644 --- 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