+
+;;; Object listing
+
+
+
+(defmethod database-create (connection-spec (type (eql :postgresql)))
+ (destructuring-bind (host name user password) connection-spec
+ (let ((database (database-connect (list host "postgres" user password)
+ type)))
+ (setf (slot-value database 'clsql-sys::state) :open)
+ (unwind-protect
+ (database-execute-command (format nil "create database ~A" name) database)
+ (database-disconnect database)))))
+
+(defmethod database-destroy (connection-spec (type (eql :postgresql)))
+ (destructuring-bind (host name user password) connection-spec
+ (let ((database (database-connect (list host "postgres" user password)
+ type)))
+ (setf (slot-value database 'clsql-sys::state) :open)
+ (unwind-protect
+ (database-execute-command (format nil "drop database ~A" name) database)
+ (database-disconnect database)))))
+
+
+(defmethod database-probe (connection-spec (type (eql :postgresql)))
+ (when (find (second connection-spec) (database-list connection-spec type)
+ :test #'string-equal)
+ t))
+
+
+(defun %pg-database-connection (connection-spec)
+ (check-connection-spec connection-spec :postgresql
+ (host db user password &optional port options tty))
+ (macrolet ((coerce-string (var)
+ `(unless (typep ,var 'simple-base-string)
+ (setf ,var (coerce ,var 'simple-base-string)))))
+ (destructuring-bind (host db user password &optional port options tty)
+ connection-spec
+ (coerce-string db)
+ (coerce-string user)
+ (let ((connection (PQsetdbLogin host port options tty db user password)))
+ (declare (type pgsql::pgsql-conn-ptr connection))
+ (unless (eq (PQstatus connection)
+ pgsql-conn-status-type#connection-ok)
+ ;; Connect failed
+ (error 'sql-connection-error
+ :database-type :postgresql
+ :connection-spec connection-spec
+ :error-id (PQstatus connection)
+ :message (PQerrorMessage connection)))
+ connection))))
+
+(defmethod database-reconnect ((database postgresql-database))
+ (let ((lock (database-lock database)))
+ (with-process-lock (lock "Reconnecting")
+ (with-slots (connection-spec conn-ptr)
+ database
+ (setf conn-ptr (%pg-database-connection connection-spec))
+ database))))
+
+;;; Database capabilities
+
+(when (clsql-sys:database-type-library-loaded :postgresql)
+ (clsql-sys:initialize-database-type :database-type :postgresql))