r9403: Rework conditions to be CommonSQL backward compatible

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

diff --git a/db-postgresql/postgresql-sql.lisp b/db-postgresql/postgresql-sql.lisp
index 156e11e08c26abebb0c8863321b041bb9abff2d9..447bd7e212bb7d91e15d5f2a7432444991183330 100644 (file)
--- a/db-postgresql/postgresql-sql.lisp
+++ b/db-postgresql/postgresql-sql.lisp
@@ -16,7 +16,7 @@
 (in-package #:cl-user)
 
 (defpackage #:clsql-postgresql
-    (:use #:common-lisp #:clsql-base-sys #:postgresql #:clsql-uffi)
+    (:use #:common-lisp #:clsql-sys #:postgresql #:clsql-uffi)
     (:export #:postgresql-database)
     (:documentation "This is the CLSQL interface to PostgreSQL."))
 
@@ -127,12 +127,12 @@
        (declare (type pgsql-conn-def connection))
        (when (not (eq (PQstatus connection) 
                       pgsql-conn-status-type#connection-ok))
-         (error 'clsql-connect-error
+         (error 'sql-connection-error
                 :database-type database-type
                 :connection-spec connection-spec
-                :errno (PQstatus connection)
-                :error (tidy-error-message 
-                        (PQerrorMessage connection))))
+                :error-id (PQstatus connection)
+                :message (tidy-error-message 
+                          (PQerrorMessage connection))))
        (make-instance 'postgresql-database
                       :name (database-name-from-spec connection-spec
                                                      database-type)
@@ -152,11 +152,10 @@
     (uffi:with-cstring (query-native query-expression)
       (let ((result (PQexec conn-ptr query-native)))
         (when (uffi:null-pointer-p result)
-          (error 'clsql-sql-error
+          (error 'sql-database-data-error
                  :database database
                  :expression query-expression
-                 :errno nil
-                 :error (tidy-error-message (PQerrorMessage conn-ptr))))
+                 :message (tidy-error-message (PQerrorMessage conn-ptr))))
         (unwind-protect
             (case (PQresultStatus result)
               (#.pgsql-exec-status-type#empty-query
@@ -179,12 +178,12 @@
                   (when field-names
                     (result-field-names num-fields result)))))
               (t
-               (error 'clsql-sql-error
+               (error 'sql-database-data-error
                       :database database
                       :expression query-expression
-                      :errno (PQresultStatus result)
-                      :error (tidy-error-message
-                              (PQresultErrorMessage result)))))
+                      :error-id (PQresultStatus result)
+                      :message (tidy-error-message
+                               (PQresultErrorMessage result)))))
           (PQclear result))))))
 
 (defun result-field-names (num-fields result)
@@ -192,7 +191,7 @@
   (let ((names '()))
     (dotimes (i num-fields (nreverse names))
       (declare (fixnum i))
-      (push (uffi:convert-from-foreign-string (PQfname result i)) names))))
+      (push (uffi:convert-from-cstring (PQfname result i)) names))))
 
 (defmethod database-execute-command (sql-expression
                                      (database postgresql-database))
@@ -201,11 +200,10 @@
     (uffi:with-cstring (sql-native sql-expression)
       (let ((result (PQexec conn-ptr sql-native)))
         (when (uffi:null-pointer-p result)
-          (error 'clsql-sql-error
+          (error 'sql-database-data-error
                  :database database
                  :expression sql-expression
-                 :errno nil
-                 :error (tidy-error-message (PQerrorMessage conn-ptr))))
+                 :message (tidy-error-message (PQerrorMessage conn-ptr))))
         (unwind-protect
             (case (PQresultStatus result)
               (#.pgsql-exec-status-type#command-ok
@@ -215,12 +213,12 @@
                (warn "Strange result...")
                t)
               (t
-               (error 'clsql-sql-error
+               (error 'sql-database-data-error
                       :database database
                       :expression sql-expression
-                      :errno (PQresultStatus result)
-                      :error (tidy-error-message
-                              (PQresultErrorMessage result)))))
+                      :error-id (PQresultStatus result)
+                      :message (tidy-error-message
+                               (PQresultErrorMessage result)))))
           (PQclear result))))))
 
 (defstruct postgresql-result-set
@@ -239,11 +237,10 @@
     (uffi:with-cstring (query-native query-expression)
       (let ((result (PQexec conn-ptr query-native)))
         (when (uffi:null-pointer-p result)
-          (error 'clsql-sql-error
+          (error 'sql-database-data-error
                  :database database
                  :expression query-expression
-                 :errno nil
-                 :error (tidy-error-message (PQerrorMessage conn-ptr))))
+                 :message (tidy-error-message (PQerrorMessage conn-ptr))))
         (case (PQresultStatus result)
           ((#.pgsql-exec-status-type#empty-query
             #.pgsql-exec-status-type#tuples-ok)
@@ -263,12 +260,12 @@
                         (PQnfields result)))))
          (t
           (unwind-protect
-               (error 'clsql-sql-error
+               (error 'sql-database-data-error
                       :database database
                       :expression query-expression
-                      :errno (PQresultStatus result)
-                      :error (tidy-error-message
-                              (PQresultErrorMessage result)))
+                      :error-id (PQresultStatus result)
+                      :message (tidy-error-message
+                               (PQresultErrorMessage result)))
              (PQclear result))))))))
   
 (defmethod database-dump-result-set (result-set (database postgresql-database))
@@ -444,16 +441,15 @@
                            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-database)
@@ -520,34 +516,30 @@
   (destructuring-bind (host name user password) connection-spec
     (declare (ignore user password))
     (multiple-value-bind (output status)
-       (clsql-base-sys:command-output "createdb -h~A ~A"
+       (clsql-sys:command-output "createdb -h~A ~A"
                                       (if host host "localhost")
                                       name)
       (if (or (not (zerop status))
              (search "database creation failed: ERROR:" output))
-         (error 'clsql-access-error
-                :connection-spec connection-spec
-                :database-type type
-                :error 
-                (format nil "database-create failed: ~A" 
-                        output))
+         (error 'sql-database-error
+                :message
+                (format nil "createdb failed for postgresql backend with connection spec ~A."
+                        connection-spec))
        t))))
 
 (defmethod database-destroy (connection-spec (type (eql :postgresql)))
   (destructuring-bind (host name user password) connection-spec
     (declare (ignore user password))
     (multiple-value-bind (output status)
-       (clsql-base-sys:command-output "dropdb -h~A ~A"
+       (clsql-sys:command-output "dropdb -h~A ~A"
                                       (if host host "localhost")
                                       name)
       (if (or (not (zerop status))
              (search "database removal failed: ERROR:" output))
-         (error 'clsql-access-error
-                :connection-spec connection-spec
-                :database-type type
-                :error 
-                (format nil "database-destory failed: ~A" 
-                        output))
+         (error 'sql-database-error
+                :message
+                (format nil "dropdb failed for postgresql backend with connection spec ~A."
+                        connection-spec))
        t))))
 
 
@@ -563,12 +555,12 @@
                                      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 nil 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-database) table)
   (database-query 
@@ -595,11 +587,11 @@
         (declare (type postgresql::pgsql-conn-ptr connection))
         (unless (eq (PQstatus connection) :connection-ok)
           ;; Connect failed
-          (error 'clsql-connect-error
+          (error 'sql-connection-error
                  :database-type :postgresql
                  :connection-spec connection-spec
-                 :errno (PQstatus connection)
-                 :error (PQerrorMessage connection)))
+                 :error-id (PQstatus connection)
+                 :message (PQerrorMessage connection)))
         connection))))
 
 (defmethod database-reconnect ((database postgresql-database))
@@ -618,5 +610,5 @@
 (defmethod db-type-default-case ((db-type (eql :postgresql)))
   :lower)
 
-(when (clsql-base-sys:database-type-library-loaded :postgresql)
-  (clsql-base-sys:initialize-database-type :database-type :postgresql))
+(when (clsql-sys:database-type-library-loaded :postgresql)
+  (clsql-sys:initialize-database-type :database-type :postgresql))