"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,
"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,
- :message
- (format nil
- "Created new connection ~A to database ~A~%, although there is an existing connection (~A)."
- result (database-name result) old-db)))
- (:error
+ :message
+ (format nil
+ "Created new connection ~A to database ~A~%, although there is an existing connection (~A)."
+ result (database-name result) old-db)))
+ (:error
- (error 'sql-connection-error
- :message
- (format nil "There is an existing connection ~A to database ~A."
- old-db
- (database-name old-db)))
+ (error 'sql-connection-error
+ :message
+ (format nil "There is an existing connection ~A to database ~A."
+ old-db
+ (database-name old-db)))
(defun reconnect (&key (database *default-database*) (error nil) (force t))
"Reconnects DATABASE which defaults to *DEFAULT-DATABASE* to
(defun reconnect (&key (database *default-database*) (error nil) (force t))
"Reconnects DATABASE which defaults to *DEFAULT-DATABASE* to
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
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 'sql-connection-error
- :message
- (format nil "Unable to find database with connection-spec ~A." database))
- (return-from reconnect nil)))
- db)))))
+ (database database)
+ ((or string list)
+ (let ((db (find-database database :errorp nil)))
+ (when (null db)
+ (if (and database error)
+ (error 'sql-connection-error
+ :message
+ (format nil "Unable to find database with connection-spec ~A." database))
+ (return-from reconnect nil)))
+ db)))))
- (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)
+ (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)
(sizes (compute-sizes (cons titles data)))
(total-size (+ (apply #'+ sizes) (* 2 (1- (length titles)))))
(control-string (format nil "~~&~~{~{~~~AA ~}~~}" sizes)))
(sizes (compute-sizes (cons titles data)))
(total-size (+ (apply #'+ sizes) (* 2 (1- (length titles)))))
(control-string (format nil "~~&~~{~{~~~AA ~}~~}" sizes)))
(setq connection-spec (string-to-list-connection-spec connection-spec)))
(database-list connection-spec database-type))
(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)
+(defmacro with-database ((db-var connection-spec
+ &key make-default pool
+ (if-exists *connect-if-exists*)
+ (database-type *default-database-type*))
+ &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
"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."
- (unless db-var (setf db-var '*default-database*))
- `(let ((,db-var (connect ,connection-spec ,@connect-args)))
+from the body. MAKE-DEFAULT has a default value of NIL."
+ `(let ((,db-var (connect ,connection-spec
+ :database-type ,database-type
+ :if-exists ,if-exists
+ :pool ,pool
+ :make-default ,make-default)))