X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=db-postgresql-socket%2Fpostgresql-socket-sql.lisp;h=0bfc01b5a025796d259c92fc52b17dbc8490b080;hp=07032b826fd7ede336395c338bff5f159f1b0662;hb=8c6c643e3debe875bd14408cc3129d8148dfd125;hpb=f716bb1161cf9e89a96945c4a444244f9d303691 diff --git a/db-postgresql-socket/postgresql-socket-sql.lisp b/db-postgresql-socket/postgresql-socket-sql.lisp index 07032b8..0bfc01b 100644 --- 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))