X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=base%2Fdatabase.lisp;h=f5a682e1bf77f1694c2677dfc8afcd368fb9e022;hp=cc26d7119c517449b603ed41b654adeec3594017;hb=09f07ac9d914a83f9426609f3264f4e66b5a6d97;hpb=a3e1cd20eec3903790c6e8f126345558904488f4 diff --git a/base/database.lisp b/base/database.lisp index cc26d71..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))) @@ -201,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)))