(in-package #:clsql-sys)
-(setf (documentation 'database-name 'function)
- "Returns the name of a database.")
-
-;;; Database handling
(defvar *connect-if-exists* :error
"Default value for the if-exists keyword argument in calls to
(database
(values database 1))
(string
- (let* ((matches (remove-if
+ (let* ((matches (remove-if
#'(lambda (db)
(not (and (string= (database-name db) database)
(if db-type
:message
(format nil "There exists ~A database called ~A."
(if (zerop count) "no" "more than one")
- database)))))))
+ database)))))
+ (null
+ (error "A database must be specified rather than NIL."))))
(defun connect (connection-spec
(unless database-type
(error 'sql-database-error :message "Must specify a database-type."))
-
+
(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
+ (concatenate 'string
(symbol-name '#:clsql-)
(symbol-name database-type)))))
(if pool
- (acquire-from-pool connection-spec database-type pool)
+ (let ((conn (acquire-from-pool connection-spec database-type pool)))
+ (when make-default (setq *default-database* conn))
+ conn)
(let* ((db-name (database-name-from-spec connection-spec database-type))
(old-db (unless (eq if-exists :new)
(find-database db-name :db-type database-type
(restart-case
(error 'sql-connection-error
:message
- "There is an existing connection ~A to database ~A."
+ (format nil "There is an existing connection ~A to database ~A."
old-db
- (database-name old-db))
+ (database-name old-db)))
(create-new ()
:report "Create a new connection."
(setq result
and signal an sql-user-error if they don't match. This function
is called by database backends."
`(handler-case
- (destructuring-bind ,template ,connection-spec
+ (destructuring-bind ,template ,connection-spec
(declare (ignore ,@(remove '&optional template)))
t)
- (error ()
+ (error ()
(error 'sql-user-error
:message
- (format nil
+ (format nil
"The connection specification ~A~%is invalid for database type ~A.~%The connection specification must conform to ~A"
,connection-spec
,database-type
(let ((db (find-database database :errorp nil)))
(when (null db)
(if (and database error)
- (error 'clsql-generic-error
+ (error 'sql-connection-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)
"Prints information about the currently connected databases to
*STANDARD-OUTPUT*. The argument FULL is nil by default and a
(flet ((get-data ()
(let ((data '()))
(dolist (db (connected-databases) data)
- (push
- (append
- (list (if (equal db *default-database*) "*" "")
+ (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))
+ (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
+ (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))))))
(format t "~&CLSQL STATUS: ~A~%" (iso-timestring (get-time)))
(let ((data (get-data)))
(when data
- (let* ((titles (if full
- (list "" "DATABASE" "TYPE" "RECORDING" "POOLED"
+ (let* ((titles (if full
+ (list "" "DATABASE" "TYPE" "RECORDING" "POOLED"
"TABLES" "VIEWS")
(list "" "DATABASE" "TYPE" "RECORDING")))
(sizes (compute-sizes (cons titles data)))
(values)))
(defun create-database (connection-spec &key database-type)
+ "This function creates a database in the database system specified
+by DATABASE-TYPE."
(when (stringp connection-spec)
(setq connection-spec (string-to-list-connection-spec connection-spec)))
(database-create connection-spec database-type))
(defun probe-database (connection-spec &key database-type)
+ "This function tests for the existence of a database in the database
+system specified by DATABASE-TYPE."
(when (stringp connection-spec)
(setq connection-spec (string-to-list-connection-spec connection-spec)))
(database-probe connection-spec database-type))
(defun destroy-database (connection-spec &key database-type)
+ "This function destroys a database in the database system specified
+by DATABASE-TYPE."
(when (stringp connection-spec)
(setq connection-spec (string-to-list-connection-spec connection-spec)))
(database-destroy connection-spec database-type))
(defun list-databases (connection-spec &key database-type)
+ "This function returns a list of databases existing in the database
+system specified by 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
-database connection given by `connection-spec' and `connect-args'.
-The connection is automatically closed or released to the pool on exit from the body."
+ "Evaluate the body in an environment, where DB-VAR is bound to the
+database connection given by CONNECTION-SPEC and CONNECT-ARGS. The
+connection is automatically closed or released to the pool on exit
+from the body."
(let ((result (gensym "result-")))
(unless db-var (setf db-var '*default-database*))
`(let ((,db-var (connect ,connection-spec ,@connect-args))
projects / clsql.git / blobdiff