r8973: add makefiles, remove explain function, fix truncate

[clsql.git] / base / database.lisp

diff --git a/base/database.lisp b/base/database.lisp
index a7313ebc62fd62b25ea63dcffa6dcea5bada5b18..1c6fa63ee82fc12911175575a755470b3e8854aa 100644 (file)
--- a/base/database.lisp
+++ b/base/database.lisp
@@ -32,6 +32,9 @@
 (defvar *default-database* nil
   "Specifies the default database to be used.")
 
 (defvar *default-database* nil
   "Specifies the default database to be used.")
 

+(defun is-database-open (database)
+  (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
 (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


@@ -85,6 +88,12 @@ is a conn-pool object the connection will be taken from this pool."
   (when (stringp connection-spec)
     (setq connection-spec (string-to-list-connection-spec connection-spec)))
   
   (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 
+                                             (symbol-name '#:clsql-)
+                                             (symbol-name database-type)))))
+

   (if pool
       (acquire-from-pool connection-spec database-type pool)
       (let* ((db-name (database-name-from-spec connection-spec database-type))
   (if pool
       (acquire-from-pool connection-spec database-type pool)
       (let* ((db-name (database-name-from-spec connection-spec database-type))


@@ -116,6 +125,7 @@ is a conn-pool object the connection will be taken from this pool."
             (setq result
                   (database-connect connection-spec database-type)))
         (when result
             (setq result
                   (database-connect connection-spec database-type)))
         (when result

+         (setf (slot-value result 'state) :open)

           (pushnew result *connected-databases*)
           (when make-default (setq *default-database* result))
           result))))
           (pushnew result *connected-databases*)
           (when make-default (setq *default-database* result))
           result))))


@@ -143,7 +153,7 @@ this pool."
             (setf *connected-databases* (delete database *connected-databases*))
             (when (eq database *default-database*)
               (setf *default-database* (car *connected-databases*)))
             (setf *connected-databases* (delete database *connected-databases*))
             (when (eq database *default-database*)
               (setf *default-database* (car *connected-databases*)))

-            (change-class database 'closed-database)
+            (setf (slot-value database 'state) :closed)

             t)))))
 
 
             t)))))
 
 


@@ -166,10 +176,10 @@ 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."
 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."

-  ;; TODO: just a placeholder
+  ;; TODO: Support all backends. Perhaps integrate with pools
+  ;; Handle error and force keywords

   (declare (ignore database error force)))
 
   (declare (ignore database error force)))
 

-

   
 (defun status (&optional full)
   "The function STATUS prints status information to the standard
   
 (defun status (&optional full)
   "The function STATUS prints status information to the standard


@@ -206,6 +216,21 @@ of full is NIL."
           (print-separator total-size))))
     (values)))
 
           (print-separator total-size))))
     (values)))
 

+(defun create-database (connection-spec &key 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)
+  (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)
+  (when (stringp connection-spec)
+    (setq connection-spec (string-to-list-connection-spec connection-spec)))
+  (database-destroy 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
 
 (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


@@ -227,3 +252,4 @@ The connection is automatically closed or released to the pool on exit from the
   `(progv '(*default-database*)
        (list ,database)
      ,@body))
   `(progv '(*default-database*)
        (list ,database)
      ,@body))

+