(in-package #:clsql-sys)
+(defvar *default-encoding*
+ (or #+sbcl sb-impl::*default-external-format*
+ :utf-8))
(defvar *connect-if-exists* :error
"Default value for the if-exists keyword argument in calls to
CONNECT. Meaningful values are :new, :warn-new, :error, :warn-old
and :old.")
+;;TODO: this variable appears to be global, not thread specific and is
+;; not protected when modifying the list.
(defvar *connected-databases* nil
"List of active database objects.")
(make-default t)
(pool nil)
(database-type *default-database-type*)
- (encoding nil))
+ (encoding *default-encoding*))
"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,
:verbose nil))
(if pool
- (let ((conn (acquire-from-pool connection-spec database-type pool)))
+ (let ((conn (acquire-from-pool connection-spec database-type pool encoding)))
(when make-default (setq *default-database* conn))
conn)
(let* ((db-name (database-name-from-spec connection-spec database-type))
(setf *default-database* (car *connected-databases*)))
t))
(when (database-disconnect database)
+ ;;TODO: RACE COND: 2 threads disconnecting could stomp on *connected-databases*
(setf *connected-databases* (delete database *connected-databases*))
(when (eq database *default-database*)
(setf *default-database* (car *connected-databases*)))
is called by database backends."
`(handler-case
(destructuring-bind ,template ,connection-spec
- (declare (ignore ,@(remove '&optional template)))
+ (declare (ignore ,@(remove-if
+ (lambda (x) (member x '(&key &rest &optional)))
+ template)))
t)
(error ()
(error 'sql-user-error
(ignore-errors (disconnect :database db))
(disconnect :database db :error nil)))
- (connect (connection-spec db))))
+ (connect (connection-spec db) :encoding (encoding db))))
(defun status (&optional full)
(database-list connection-spec database-type))
(defun encoding (db)
- (when (typep db 'database)
- (slot-value db 'encoding)))
+ (or (when (typep db 'database)
+ (slot-value db 'encoding))
+ *default-encoding*))
(defun (setf encoding) (encoding db)
(when (typep db 'database)
(setf (slot-value db 'encoding) encoding)
(when (eql (slot-value db 'state) :open)
- (case database-type
+ (case (database-type db)
;; FIXME: If database object is open then
;; send command to SQL engine specifying the character
;; encoding for the database