X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=sql%2Fdatabase.lisp;h=704029f6340fc2378a9ee83c582598c12e871170;hp=b02a75a4fc85bead6283cdeba524ab9fa0f8351c;hb=8c6c643e3debe875bd14408cc3129d8148dfd125;hpb=5be31565b7d87b90f0e79a9e61af84ad05e12920

diff --git a/sql/database.lisp b/sql/database.lisp
index b02a75a..704029f 100644
--- a/sql/database.lisp
+++ b/sql/database.lisp
@@ -86,7 +86,7 @@ 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)))
@@ -109,10 +109,18 @@ is a conn-pool object the connection will be taken from this pool."
               (: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
+			  "There is an existing connection ~A to database ~A."
+			  old-db
+			  (database-name old-db))
                  (create-new ()
                    :report "Create a new connection."
                    (setq result
@@ -122,7 +130,12 @@ is a conn-pool object the connection will be taken from this pool."
                    (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
@@ -163,8 +176,22 @@ this pool."
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 
-
-
+(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