r9082: fix sequence, error-string

[clsql.git] / base / database.lisp

diff --git a/base/database.lisp b/base/database.lisp
index 7cf45f18485702104768a8ba31bd5b30d23a45d6..1e64fb3588d388c814fc9ad7514ea69f9c2de523 100644 (file)
--- a/base/database.lisp
+++ b/base/database.lisp
@@ -32,6 +32,9 @@
 (defvar *default-database* nil
   "Specifies the default database to be used.")
 
 (defvar *default-database* nil
   "Specifies the default database to be used.")
 

+(defun is-database-open (database)
+  (eql (database-state database) :open))
+

 (defun find-database (database &key (errorp t) (db-type nil))
   "The function FIND-DATABASE, given a string DATABASE, searches
 amongst the connected databases for one matching the name DATABASE. If
 (defun find-database (database &key (errorp t) (db-type nil))
   "The function FIND-DATABASE, given a string DATABASE, searches
 amongst the connected databases for one matching the name DATABASE. If


@@ -85,6 +88,12 @@ is a conn-pool object the connection will be taken from this pool."
   (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)))
   

+  (unless (member database-type *loaded-database-types*)
+    (asdf:operate 'asdf:load-op (ensure-keyword
+                                (concatenate 'string 
+                                             (symbol-name '#:clsql-)
+                                             (symbol-name database-type)))))
+

   (if pool
       (acquire-from-pool connection-spec database-type pool)
       (let* ((db-name (database-name-from-spec connection-spec database-type))
   (if pool
       (acquire-from-pool connection-spec database-type pool)
       (let* ((db-name (database-name-from-spec connection-spec database-type))


@@ -116,6 +125,7 @@ is a conn-pool object the connection will be taken from this pool."
             (setq result
                   (database-connect connection-spec database-type)))
         (when result
             (setq result
                   (database-connect connection-spec database-type)))
         (when result

+         (setf (slot-value result 'state) :open)

           (pushnew result *connected-databases*)
           (when make-default (setq *default-database* result))
           result))))
           (pushnew result *connected-databases*)
           (when make-default (setq *default-database* result))
           result))))


@@ -143,7 +153,7 @@ this pool."
             (setf *connected-databases* (delete database *connected-databases*))
             (when (eq database *default-database*)
               (setf *default-database* (car *connected-databases*)))
             (setf *connected-databases* (delete database *connected-databases*))
             (when (eq database *default-database*)
               (setf *default-database* (car *connected-databases*)))

-            (change-class database 'closed-database)
+            (setf (slot-value database 'state) :closed)

             t)))))
 
 
             t)))))
 
 


@@ -166,9 +176,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: just a placeholder
-  (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)


@@ -219,7 +244,7 @@ of full is NIL."
 (defun destroy-database (connection-spec &key database-type)
   (when (stringp connection-spec)
     (setq connection-spec (string-to-list-connection-spec connection-spec)))
 (defun destroy-database (connection-spec &key database-type)
   (when (stringp connection-spec)
     (setq connection-spec (string-to-list-connection-spec connection-spec)))

-  (database-destory connection-spec database-type))
+  (database-destroy connection-spec database-type))

 
 
 (defmacro with-database ((db-var connection-spec &rest connect-args) &body body)
 
 
 (defmacro with-database ((db-var connection-spec &rest connect-args) &body body)