X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=db-postgresql-socket3%2Fsql.lisp;h=7f545c80ee63eb4124ed9eb07ff9a53199286e8d;hb=9347205f5d899b30b8bb4429bf47ae59709c14d7;hp=11261624640a71830ea6484f640d10811647bc3d;hpb=cd5e9105458b573cef241cf59702604f45e004b5;p=clsql.git

diff --git a/db-postgresql-socket3/sql.lisp b/db-postgresql-socket3/sql.lisp
index 1126162..7f545c8 100644
--- a/db-postgresql-socket3/sql.lisp
+++ b/db-postgresql-socket3/sql.lisp
@@ -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)
 
 
@@ -201,11 +205,56 @@
 	(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
 
@@ -284,4 +333,20 @@
 
 (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
+  val)
+
+(defmethod clsql-sys::%table-exists-p (name (database postgresql-socket3-database) &key owner )
+  (unless database (setf database *default-database*))
+  (when (clsql:query (command-object "SELECT 1 FROM information_schema.tables WHERE table_name=$1 and ($2::text IS NULL or table_schema = $2::text)"
+				     (list name owner))
+		     :flatp T
+		     :database database)
+    T))
+
+(defmethod database-list-tables ((database postgresql-socket3-database) &key owner)
+  (clsql:query (command-object "
+SELECT table_name FROM information_schema.tables
+                                WHERE ($1::Text IS NULL or table_schema = $1::text)"
+			       (list (or owner :null)))
+	       :flatp T
+	       :database database))