created a command object function to slim down the typing neccessary to use one

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

diff --git a/db-postgresql-socket3/sql.lisp b/db-postgresql-socket3/sql.lisp
index 04b18974d52bb7f8157e3690f1272d16bb190283..e2515005cb5cda828bd910484cb89d7d94e8dba2 100644 (file)
--- a/db-postgresql-socket3/sql.lisp
+++ b/db-postgresql-socket3/sql.lisp
@@ -58,11 +58,11 @@
   (ecase *backend-warning-behavior*
     (:warn
      (warn 'sql-database-warning :database database
-           :message (postgresql-condition-message condition)))
+           :message (cl-postgres:database-error-message condition)))
     (:error
      (error 'sql-database-error :database database
             :message (format nil "Warning upgraded to error: ~A"
-                             (postgresql-condition-message condition))))
+                             (cl-postgres:database-error-message condition))))
     ((:ignore nil)
      ;; do nothing
      )))
@@ -72,7 +72,7 @@
          :database database
          :expression expression
          :error-id (type-of condition)
-         :message (postgresql-condition-message condition)))
+         :message (cl-postgres:database-error-message condition)))
 
 (defmacro with-postgresql-handlers
     ((database &optional expression)
@@ -84,7 +84,7 @@
        (handler-bind ((postgresql-warning
                        (lambda (c)
                          (convert-to-clsql-warning ,database-var c)))
-                      (postgresql-error
+                      (cl-postgres:database-error
                        (lambda (c)
                          (convert-to-clsql-error
                           ,database-var ,expression-var c))))
@@ -142,7 +142,7 @@
                :database-type database-type
                :connection-spec connection-spec
                :error-id (type-of c)
-               :message (postgresql-condition-message c)))
+               :message (cl-postgres:database-error-message c)))
       (:no-error (connection)
                  ;; Success, make instance
                  (make-instance 'postgresql-socket3-database
@@ -155,6 +155,10 @@
   (cl-postgres:close-database (database-connection database))
   t)
 
+(defmethod clsql-sys::release-to-conn-pool :before ((conn postgresql-socket3-database))
+  ;; This resets the connection to "New" state
+  (database-execute-command "DISCARD ALL;" conn))
+
 (defvar *include-field-names* nil)
 
 
@@ -184,27 +188,73 @@
                 nil
                 (funcall (cl-postgres::field-interpreter cl-postgres::field)
                          stream cl-postgres::size)))))
-    (values
-      (loop :while (cl-postgres:next-row)
-           :collect (loop :for field :across fields
-                          :collect (cl-postgres:next-field field)))
-      (when *include-field-names*
-       (loop :for field :across fields
-             :collect (cl-postgres:field-name field))))))
+    (let ((results (loop :while (cl-postgres:next-row)
+                        :collect (loop :for field :across fields
+                                       :collect (cl-postgres:next-field field))))
+         (col-names (when *include-field-names*
+                      (loop :for field :across fields
+                            :collect (cl-postgres:field-name field)))))
+      ;;multiple return values were not working here
+      (list results col-names))))
 
 (defmethod database-query ((expression string) (database postgresql-socket3-database) result-types field-names)
   (let ((connection (database-connection database))
        (cl-postgres:*sql-readtable* *sqlreader*))
     (with-postgresql-handlers (database expression)
       (let ((*include-field-names* field-names))
-       (cl-postgres:exec-query connection expression #'clsql-default-row-reader))
+       (apply #'values (cl-postgres:exec-query connection expression #'clsql-default-row-reader)))
       )))
 
+(defmethod query ((obj command-object) &key (database *default-database*)
+                  (result-types :auto) (flatp nil) (field-names t))
+  (clsql-sys::record-sql-command (expression obj) database)
+  (multiple-value-bind (rows names)
+      (database-query obj database result-types field-names)
+    (let ((result (if (and flatp (= 1 (length (car rows))))
+                      (mapcar #'car rows)
+                     rows)))
+      (clsql-sys::record-sql-result result database)
+      (if field-names
+          (values result names)
+         result))))
+
+(defmethod database-query ((obj command-object) (database postgresql-socket3-database) result-types field-names)
+  (let ((connection (database-connection database))
+       (cl-postgres:*sql-readtable* *sqlreader*))
+    (with-postgresql-handlers (database obj)
+      (let ((*include-field-names* field-names))
+       (unless (has-been-prepared obj)
+         (cl-postgres:prepare-query connection (prepared-name obj) (expression obj))
+         (setf (has-been-prepared obj) T))
+       (apply #'values (cl-postgres:exec-prepared
+                        connection
+                        (prepared-name obj)
+                        (parameters obj)
+                        #'clsql-default-row-reader))))))
+
 (defmethod database-execute-command
     ((expression string) (database postgresql-socket3-database))
   (let ((connection (database-connection database)))
     (with-postgresql-handlers (database expression)
-      (cl-postgres:exec-query connection expression))))
+      ;; return row count?
+      (second (multiple-value-list (cl-postgres:exec-query connection expression))))))
+
+(defmethod execute-command ((obj command-object)
+                            &key (database *default-database*))
+  (clsql-sys::record-sql-command (expression obj) database)
+  (let ((res (database-execute-command obj database)))
+    (clsql-sys::record-sql-result res database)
+    ;; return row count?
+    res))
+
+(defmethod database-execute-command
+    ((obj command-object) (database postgresql-socket3-database))
+  (let ((connection (database-connection database)))
+    (with-postgresql-handlers (database obj)
+      (unless (has-been-prepared obj)
+       (cl-postgres:prepare-query connection (prepared-name obj) (expression obj))
+       (setf (has-been-prepared obj) T))
+      (second (multiple-value-list (cl-postgres:exec-prepared connection (prepared-name obj) (parameters obj)))))))
 
 ;;;; Cursoring interface
 
@@ -273,3 +323,14 @@
 
 (when (clsql-sys:database-type-library-loaded :postgresql-socket3)
   (clsql-sys:initialize-database-type :database-type :postgresql-socket3))
+
+
+;; Type munging functions
+
+(defmethod read-sql-value (val (type (eql 'boolean)) (database postgresql-socket3-database) db-type)
+  (declare (ignore database db-type))
+  val)
+
+(defmethod read-sql-value (val (type (eql 'generalized-boolean)) (database postgresql-socket3-database) db-type)
+  (declare (ignore database db-type))
+  val)
\ No newline at end of file