X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=db-postgresql-socket3%2Fsql.lisp;h=e2515005cb5cda828bd910484cb89d7d94e8dba2;hb=1e8d22b3fdace44a45b6b0702da5587e136e2398;hp=8c2fa3efb695dc2da15ef01eedd48da7c5dbe0cd;hpb=c4bc291e3c7157b999870f606652e5f0153f6afe;p=clsql.git diff --git a/db-postgresql-socket3/sql.lisp b/db-postgresql-socket3/sql.lisp index 8c2fa3e..e251500 100644 --- 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,74 +188,93 @@ 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)))))) -;;;; Cursoring interface +(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)) -(defclass cursor () - ((next-row :accessor next-row :initarg :next-row :initform nil) - (fields :accessor fields :initarg :fields :initform nil) - (next-field :accessor next-field :initarg :next-field :initform nil) - (done :accessor done :initarg :done :initform nil))) +(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))))))) -(defvar *cursor* ()) +;;;; Cursoring interface -(cl-postgres:def-row-reader clsql-cursored-row-reader (fields) - (setf *cursor* - (make-instance 'cursor - :next-row #'cl-postgres:next-row - :fields fields - :next-field #'cl-postgres:next-field))) (defmethod database-query-result-set ((expression string) (database postgresql-socket3-database) &key full-set result-types) (declare (ignore result-types)) (declare (ignore full-set)) - (let ((connection (database-connection database)) - *cursor*) - (with-postgresql-handlers (database expression) - (cl-postgres:exec-query connection expression 'clsql-cursored-row-reader) - (break "Built cursor") - (values *cursor* (length (fields *cursor*)))))) + (error "Cursoring interface is not supported for postgresql-socket3-database try cl-postgres:exec-query with a custom row-reader")) (defmethod database-dump-result-set (result-set (database postgresql-socket3-database)) - (unless (done result-set) - (loop :while (funcall (next-row result-set)))) + (error "Cursoring interface is not supported for postgresql-socket3-database try cl-postgres:exec-query with a custom row-reader") T) (defmethod database-store-next-row (result-set (database postgresql-socket3-database) list) - (when (and (not (done result-set)) - (setf (done result-set) (funcall (next-row result-set)))) - (let* ((data (loop :for field :across (fields result-set) - :collect (funcall (next-field result-set) field)))) - ;; Maybe? - ;(setf list data) - (setf (car list) (car data) (cdr list) (cdr data)) - ))) + (error "Cursoring interface is not supported for postgresql-socket3-database try cl-postgres:exec-query with a custom row-reader")) ;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -300,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