r9186: add attribute caching, improve inititialize-database-type

[clsql.git] / base / database.lisp

diff --git a/base/database.lisp b/base/database.lisp
index 1c6fa63ee82fc12911175575a755470b3e8854aa..f3c72b65a2ead44ab85a414296ee959cbad6d2cb 100644 (file)
--- a/base/database.lisp
+++ b/base/database.lisp
@@ -85,6 +85,9 @@ to the new connection, otherwise *default-database is not changed. If
 pool is t the connection will be taken from the general pool, if pool
 is a conn-pool object the connection will be taken from this pool."
 
 pool is t the connection will be taken from the general pool, if pool
 is a conn-pool object the connection will be taken from this pool."
 

+  (unless database-type
+    (error "Must specify a database-type."))
+  

   (when (stringp connection-spec)
     (setq connection-spec (string-to-list-connection-spec connection-spec)))
   
   (when (stringp connection-spec)
     (setq connection-spec (string-to-list-connection-spec connection-spec)))
   


@@ -176,9 +179,24 @@ error should be signaled if the existing database connection cannot be
 closed. When non-nil (this is the default value) the connection is
 closed without error checking. When FORCE is nil, an error is signaled
 if the database connection has been lost."
 closed. When non-nil (this is the default value) the connection is
 closed without error checking. When FORCE is nil, an error is signaled
 if the database connection has been lost."

-  ;; TODO: Support all backends. Perhaps integrate with pools
-  ;; Handle error and force keywords
-  (declare (ignore database error force)))
+  (let ((db (etypecase database
+             (database database)
+             ((or string list)
+              (let ((db (find-database database :errorp nil)))
+                (when (null db)
+                  (if (and database error)
+                      (error 'clsql-generic-error
+                             :message
+                             (format nil "Unable to find database with connection-spec ~A." database))
+                      (return-from reconnect nil)))
+                db)))))
+                             
+    (when (is-database-open db)
+      (if force
+         (ignore-errors (disconnect :database db))
+         (disconnect :database db :error nil)))
+    
+    (connect (connection-spec db))))

 
   
 (defun status (&optional full)
 
   
 (defun status (&optional full)


@@ -231,6 +249,10 @@ of full is NIL."
     (setq connection-spec (string-to-list-connection-spec connection-spec)))
   (database-destroy connection-spec database-type))
 
     (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
 
 (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