X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=base%2Fdatabase.lisp;h=f5a682e1bf77f1694c2677dfc8afcd368fb9e022;hp=5f00b3867aee1b08c8b23d2eb7b712e23fbfca79;hb=09f07ac9d914a83f9426609f3264f4e66b5a6d97;hpb=2c14c425a4a203e03b74b868fdf727ea0d48572a

diff --git a/base/database.lisp b/base/database.lisp
index 5f00b38..f5a682e 100644
--- a/base/database.lisp
+++ b/base/database.lisp
@@ -12,7 +12,7 @@
 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
 
-(in-package #:clsql-base-sys)
+(in-package #:clsql-base)
 
 (setf (documentation 'database-name 'function)
       "Returns the name of a database.")
@@ -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."
 
+  (unless database-type
+    (error "Must specify a database-type."))
+  
   (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."
-  ;; 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)
@@ -186,26 +204,38 @@ if the database connection has been lost."
 output, for the connected databases and initialized database types. If
 full is T, detailed status information is printed. The default value
 of full is NIL."
-  (declare (ignore full))
-  ;; TODO: table details if full is true?
   (flet ((get-data ()
            (let ((data '()))
              (dolist (db (connected-databases) data)
-               (push (list (database-name db)
-                           (string (database-type db))
-                           (when (conn-pool db) "T" "NIL")
-                           (format nil "~A" (length (database-list-tables db)))
-                           (format nil "~A" (length (database-list-views db)))
-                           (if (equal db *default-database*) "   *" ""))
-                     data))))
-         (compute-sizes (data)
+	       (push 
+		(append 
+		 (list (if (equal db *default-database*) "*" "")	
+		       (database-name db)
+		       (string-downcase (string (database-type db)))
+		       (cond ((and (command-recording-stream db) 
+				   (result-recording-stream db)) 
+			      "Both")
+			     ((command-recording-stream db) "Commands")
+			     ((result-recording-stream db) "Results")
+			     (t "nil")))
+		 (when full 
+		   (list 
+		    (if (conn-pool db) "t" "nil")
+		    (format nil "~A" (length (database-list-tables db)))
+		    (format nil "~A" (length (database-list-views db))))))
+		data))))
+	 (compute-sizes (data)
            (mapcar #'(lambda (x) (apply #'max (mapcar #'length x)))
                    (apply #'mapcar (cons #'list data))))
          (print-separator (size)
            (format t "~&~A" (make-string size :initial-element #\-))))
+    (format t "~&CLSQL STATUS: ~A~%" (iso-timestring (get-time)))
     (let ((data (get-data)))
       (when data
-        (let* ((titles (list "NAME" "TYPE" "POOLED" "TABLES" "VIEWS" "DEFAULT"))
+        (let* ((titles (if full 
+			   (list "" "DATABASE" "TYPE" "RECORDING" "POOLED" 
+				 "TABLES" "VIEWS")
+			   (list "" "DATABASE" "TYPE" "RECORDING")))
                (sizes (compute-sizes (cons titles data)))
                (total-size (+ (apply #'+ sizes) (* 2 (1- (length titles)))))
                (control-string (format nil "~~&~~{~{~~~AA  ~}~~}" sizes)))
@@ -231,6 +261,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