r9403: Rework conditions to be CommonSQL backward compatible

[clsql.git] / db-postgresql-socket / postgresql-socket-sql.lisp

diff --git a/db-postgresql-socket/postgresql-socket-sql.lisp b/db-postgresql-socket/postgresql-socket-sql.lisp
index 07032b826fd7ede336395c338bff5f159f1b0662..0bfc01b5a025796d259c92fc52b17dbc8490b080 100644 (file)
--- a/db-postgresql-socket/postgresql-socket-sql.lisp
+++ b/db-postgresql-socket/postgresql-socket-sql.lisp
@@ -20,7 +20,7 @@
 (in-package #:cl-user)
 
 (defpackage :clsql-postgresql-socket
-    (:use #:common-lisp #:clsql-base-sys #:postgresql-socket)
+    (:use #:common-lisp #:clsql-sys #:postgresql-socket)
     (:export #:postgresql-socket-database)
     (:documentation "This is the CLSQL socket interface to PostgreSQL."))
 
@@ -29,7 +29,7 @@
 ;; interface foreign library loading routines
 
 
-(clsql-base-sys:database-type-load-foreign :postgresql-socket)
+(clsql-sys:database-type-load-foreign :postgresql-socket)
 
 
 ;; Field type conversion
@@ -104,14 +104,24 @@ doesn't depend on UFFI."
 
 
 (defun convert-to-clsql-warning (database condition)
-  (warn 'clsql-database-warning :database database
-       :message (postgresql-condition-message condition)))
+  (ecase *backend-warning-behavior*
+    (:warn
+     (warn 'sql-database-warning :database database
+          :message (postgresql-condition-message condition)))
+    (:error
+     (error 'sql-database-error :database database
+           :message (format nil "Warning upgraded to error: ~A" 
+                            (postgresql-condition-message condition))))
+    ((:ignore nil)
+     ;; do nothing
+     )))
 
 (defun convert-to-clsql-error (database expression condition)
-  (error 'clsql-sql-error :database database
+  (error 'sql-database-data-error
+        :database database
         :expression expression
-        :errno (type-of condition)
-        :error (postgresql-condition-message condition)))
+        :error-id (type-of condition)
+        :message (postgresql-condition-message condition)))
 
 (defmacro with-postgresql-handlers
     ((database &optional expression)
@@ -127,7 +137,6 @@ doesn't depend on UFFI."
                       (lambda (c)
                         (convert-to-clsql-error
                          ,database-var ,expression-var c))))
-        ;; KMR - removed double @@
         ,@body))))
 
 (defmethod database-initialize-database-type ((database-type
@@ -183,11 +192,11 @@ doesn't depend on UFFI."
                                      :password password))
       (postgresql-error (c)
        ;; Connect failed
-       (error 'clsql-connect-error
+       (error 'sql-connection-error
               :database-type database-type
               :connection-spec connection-spec
-              :errno (type-of c)
-              :error (postgresql-condition-message c)))
+              :error-id (type-of c)
+              :message (postgresql-condition-message c)))
       (:no-error (connection)
                 ;; Success, make instance
                 (make-instance 'postgresql-socket-database
@@ -209,11 +218,11 @@ doesn't depend on UFFI."
          (wait-for-query-results connection)
        (unless (eq status :cursor)
          (close-postgresql-connection connection)
-         (error 'clsql-sql-error
+         (error 'sql-database-data-error
                 :database database
                 :expression expression
-                :errno 'missing-result
-                :error "Didn't receive result cursor for query."))
+                :error-id "missing-result"
+                :message "Didn't receive result cursor for query."))
        (setq result-types (canonicalize-types result-types cursor))
         (values
          (loop for row = (read-cursor-row cursor result-types)
@@ -222,11 +231,11 @@ doesn't depend on UFFI."
                finally
                (unless (null (wait-for-query-results connection))
                  (close-postgresql-connection connection)
-                 (error 'clsql-sql-error
+                 (error 'sql-database-data-error
                         :database database
                         :expression expression
-                        :errno 'multiple-results
-                        :error "Received multiple results for query.")))
+                        :error-id "multiple-results"
+                        :message "Received multiple results for query.")))
          (when field-names
           (mapcar #'car (postgresql-cursor-fields cursor))))))))
 
@@ -239,30 +248,30 @@ doesn't depend on UFFI."
          (wait-for-query-results connection)
        (when (eq status :cursor)
          (loop
-             (multiple-value-bind (row stuff)
-                 (skip-cursor-row result)
-               (unless row
-                 (setq status :completed result stuff)
-                 (return)))))
+           (multiple-value-bind (row stuff)
+               (skip-cursor-row result)
+             (unless row
+               (setq status :completed result stuff)
+               (return)))))
        (cond
-         ((null status)
-          t)
-         ((eq status :completed)
-          (unless (null (wait-for-query-results connection))
+        ((null status)
+         t)
+        ((eq status :completed)
+         (unless (null (wait-for-query-results connection))
             (close-postgresql-connection connection)
-            (error 'clsql-sql-error
+            (error 'sql-database-data-error
                    :database database
                    :expression expression
-                   :errno 'multiple-results
-                   :error "Received multiple results for command."))
-          result)
+                   :error-id "multiple-results"
+                   :message "Received multiple results for command."))
+         result)
          (t
           (close-postgresql-connection connection)
-          (error 'clsql-sql-error
+          (error 'sql-database-data-error
                  :database database
                  :expression expression
-                 :errno 'missing-result
-                 :error "Didn't receive completion for command.")))))))
+                 :errno "missing-result"
+                 :message "Didn't receive completion for command.")))))))
 
 (defstruct postgresql-socket-result-set
   (done nil)
@@ -280,11 +289,11 @@ doesn't depend on UFFI."
          (wait-for-query-results connection)
        (unless (eq status :cursor)
          (close-postgresql-connection connection)
-         (error 'clsql-sql-error
+         (error 'sql-database-data-error
                 :database database
                 :expression expression
-                :errno 'missing-result
-                :error "Didn't receive result cursor for query."))
+                :error-id "missing-result"
+                :message "Didn't receive result cursor for query."))
        (values (make-postgresql-socket-result-set
                 :done nil 
                 :cursor cursor
@@ -384,16 +393,15 @@ doesn't depend on UFFI."
                            owner-clause)
                    database nil nil))))
     (if result
-       (reverse
-         (remove-if #'(lambda (it) (member it '("cmin"
-                                                "cmax"
-                                                "xmax"
-                                                "xmin"
-                                               "oid"
-                                                "ctid"
-                                               ;; kmr -- added tableoid
-                                               "tableoid") :test #'equal)) 
-                   result)))))
+        (remove-if #'(lambda (it) (member it '("cmin"
+                                               "cmax"
+                                               "xmax"
+                                               "xmin"
+                                               "oid"
+                                               "ctid"
+                                               ;; kmr -- added tableoid
+                                               "tableoid") :test #'equal)) 
+                   result))))
 
 (defmethod database-attribute-type (attribute (table string)
                                    (database postgresql-socket-database)
@@ -486,12 +494,12 @@ doesn't depend on UFFI."
                                      type)))
       (unwind-protect
           (progn
-            (setf (slot-value database 'clsql-base-sys::state) :open)
+            (setf (slot-value database 'clsql-sys::state) :open)
             (mapcar #'car (database-query "select datname from pg_database" 
                                           database :auto nil)))
        (progn
          (database-disconnect database)
-         (setf (slot-value database 'clsql-base-sys::state) :closed))))))
+         (setf (slot-value database 'clsql-sys::state) :closed))))))
 
 (defmethod database-describe-table ((database postgresql-socket-database) 
                                    table)
@@ -517,5 +525,5 @@ doesn't depend on UFFI."
 (defmethod db-type-default-case ((db-type (eql :postgresql-socket)))
   :lower)
 
-(when (clsql-base-sys:database-type-library-loaded :postgresql-socket)
-  (clsql-base-sys:initialize-database-type :database-type :postgresql-socket))
+(when (clsql-sys:database-type-library-loaded :postgresql-socket)
+  (clsql-sys:initialize-database-type :database-type :postgresql-socket))