(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 parameter of connect calls.")
+ "Default value for the if-exists keyword argument in calls to
+CONNECT. Meaningful values are :new, :warn-new, :error, :warn-old
+and :old.")
(defvar *connected-databases* nil
"List of active database objects.")
(defun connected-databases ()
- "Return the list of active database objects."
+ "Returns the list of active database objects."
*connected-databases*)
(defvar *default-database* nil
(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
-there is exactly one such database, it is returned and the second
-return value count is 1. If more than one databases match and ERRORP
-is nil, then the most recently connected of the matching databases is
-returned and count is the number of matches. If no matching database
-is found and ERRORP is nil, then nil is returned. If none, or more
-than one, matching databases are found and ERRORP is true, then an
-error is signalled. If the argument database is a database, it is
-simply returned."
+ "Returns the connected databases of type DB-TYPE whose names
+match the string DATABASE. If DATABASE is a database object, it
+is returned. If DB-TYPE is nil all databases matching the string
+DATABASE are considered. If no matching databases are found and
+ERRORP is nil then nil is returned. If ERRORP is nil and one or
+more matching databases are found, then the most recently
+connected database is returned as a first value and the number of
+matching databases is returned as a second value. If no, or more
+than one, matching databases are found and ERRORP is true, an
+error is signalled."
(etypecase database
(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
(if (or (not errorp) (= count 1))
(values (car matches) count)
(cerror "Return nil."
- 'clsql-simple-error
- :format-control "There exists ~A database called ~A."
- :format-arguments
- (list (if (zerop count) "no" "more than one")
- database)))))))
+ 'sql-database-error
+ :message
+ (format nil "There exists ~A database called ~A."
+ (if (zerop count) "no" "more than one")
+ database)))))
+ (null
+ (error "A database must be specified rather than NIL."))))
(defun connect (connection-spec
(make-default t)
(pool nil)
(database-type *default-database-type*))
- "Connects to a database of the given database-type, using the
-type-specific connection-spec. The value of if-exists determines what
-happens if a connection to that database is already established. A
-value of :new means create a new connection. A value of :warn-new
-means warn the user and create a new connect. A value of :warn-old
-means warn the user and use the old connection. A value of :error
-means fail, notifying the user. A value of :old means return the old
-connection. If make-default is true, then *default-database* is set
-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."
+ "Connects to a database of the supplied DATABASE-TYPE which
+defaults to *DEFAULT-DATABASE-TYPE*, using the type-specific
+connection specification CONNECTION-SPEC. The value of IF-EXISTS,
+which defaults to *CONNECT-IF-EXISTS*, determines what happens if
+a connection to the database specified by CONNECTION-SPEC is
+already established. A value of :new means create a new
+connection. A value of :warn-new means warn the user and create
+a new connect. A value of :warn-old means warn the user and use
+the old connection. A value of :error means fail, notifying the
+user. A value of :old means return the old connection.
+MAKE-DEFAULT is t by default which means that *DEFAULT-DATABASE*
+is set 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."))
-
+ (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
(:warn-new
(setq result
(database-connect connection-spec database-type))
- (warn 'clsql-exists-warning :old-db old-db :new-db result))
- (:error
+ (warn 'sql-warning
+ :message
+ (format nil
+ "Created new connection ~A to database ~A~%, although there is an existing connection (~A)."
+ result (database-name result) old-db)))
+ (:error
(restart-case
- (error 'clsql-exists-error :old-db old-db)
+ (error 'sql-connection-error
+ :message
+ (format nil "There is an existing connection ~A to database ~A."
+ old-db
+ (database-name old-db)))
(create-new ()
:report "Create a new connection."
(setq result
(setq result old-db))))
(:warn-old
(setq result old-db)
- (warn 'clsql-exists-warning :old-db old-db :new-db old-db))
+ (warn 'sql-warning
+ :message
+ (format nil
+ "Using existing connection ~A to database ~A."
+ old-db
+ (database-name old-db))))
(:old
(setq result old-db)))
(setq result
(defun disconnect (&key (database *default-database*) (error nil))
- "Closes the connection to DATABASE and resets *default-database* if
-that database was disconnected. If database is a database object, then
-it is used directly. Otherwise, the list of connected databases is
-searched to find one with DATABASE as its connection
-specifications. If no such database is found, then if ERROR and
-DATABASE are both non-nil an error is signaled, otherwise DISCONNECT
-returns nil. If the database is from a pool it will be released to
-this pool."
+ "Closes the connection to DATABASE and resets
+*DEFAULT-DATABASE* if that database was disconnected. If DATABASE
+is a database instance, this object is closed. If DATABASE is a
+string, then a connected database whose name matches DATABASE is
+sought in the list of connected databases. If no matching
+database is found and ERROR and DATABASE are both non-nil an
+error is signaled, otherwise nil is returned. If the database is
+from a pool it will be released to this pool."
(let ((database (find-database database :errorp (and database error))))
(when database
(if (conn-pool database)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
+(defmacro check-connection-spec (connection-spec database-type template)
+ "Check the connection specification against the provided template,
+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
+ (declare (ignore ,@(remove '&optional template)))
+ t)
+ (error ()
+ (error 'sql-user-error
+ :message
+ (format nil
+ "The connection specification ~A~%is invalid for database type ~A.~%The connection specification must conform to ~A"
+ ,connection-spec
+ ,database-type
+ (quote ,template))))))
(defun reconnect (&key (database *default-database*) (error nil) (force t))
- "Reconnects DATABASE to its underlying RDBMS. If successful, returns
-t and the variable *default-database* is set to the newly reconnected
-database. The default value for DATABASE is *default-database*. If
-DATABASE is a database object, then it is used directly. Otherwise,
-the list of connected databases is searched to find one with database
-as its connection specifications (see CONNECT). If no such database is
-found, then if ERROR and DATABASE are both non-nil an error is
-signaled, otherwise RECONNECT returns nil. FORCE controls whether an
-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."
+ "Reconnects DATABASE which defaults to *DEFAULT-DATABASE* to
+the underlying database management system. On success, t is
+returned and the variable *DEFAULT-DATABASE* is set to the newly
+reconnected database. If DATABASE is a database instance, this
+object is closed. If DATABASE is a string, then a connected
+database whose name matches DATABASE is sought in the list of
+connected databases. If no matching database is found and ERROR
+and DATABASE are both non-nil an error is signaled, otherwise nil
+is returned. When the current database connection cannot be
+closed, if FORCE is non-nil, as it is by default, the connection
+is closed and errors are suppressed. If force is nil and the
+database connection cannot be closed, an error is signalled."
(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
+ (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)
- "The function STATUS prints status information to the standard
-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."
+ "Prints information about the currently connected databases to
+*STANDARD-OUTPUT*. The argument FULL is nil by default and a
+value of t means that more detailed information about each
+database is printed."
(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