(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
)))
: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)
(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))))
: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
(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)
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"))
;;;;;;;;;;;;;;;;;;;;;;;;;;
(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
projects / clsql.git / blobdiff