+24 Mar 2002 Kevin Rosenberg (kevin@rosenberg.net)
+
+ * Added field-types parameter to query, database-query,
+ database-query-result-set, map-query. Haven't added code
+ to utilize field types, yet.
+
+ * Changed postgresql-socket result set from cons to a structure
+
23 Mar 2002 Kevin Rosenberg (kevin@rosenberg.net)
* doc/ref.sgml: Updated MAP-QUERY example to use
<para>compatibility layer for &cmucl; specific code.</para>
</listitem>
<listitem>
-<para>improved robustness of the &mysql; back-end.</para>
+<para>much improved robustness for the &mysql; back-end.</para>
</listitem>
<listitem>
<para>improved system loading.</para>
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: aodbc-sql.cl,v 1.2 2002/03/24 04:01:26 kevin Exp $
+;;;; $Id: aodbc-sql.cl,v 1.3 2002/03/24 18:08:27 kevin Exp $
;;;;
;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
(setf (database-aodbc-conn database) nil)
t)
-(defmethod database-query (query-expression (database aodbc-database))
+(defmethod database-query (query-expression (database aodbc-database) field-types)
(handler-case
(dbi:sql query-expression :db (database-aodbc-conn database))
(error ()
(defstruct aodbc-result-set
(query nil)
- (full-set nil))
+ (field-types nil :type cons)
+ (full-set nil :type boolean))
-(defmethod database-query-result-set (query-expression
- (database aodbc-database)
- &optional full-set)
+(defmethod database-query-result-set (query-expression (database aodbc-database)
+ &key full-set field-types)
(handler-case
(multiple-value-bind (query column-names)
(dbi:sql query-expression
;;;; Original code by Pierre R. Mai
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: mysql-sql.cl,v 1.3 2002/03/24 04:01:26 kevin Exp $
+;;;; $Id: mysql-sql.cl,v 1.4 2002/03/24 18:08:27 kevin Exp $
;;;;
;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
(defstruct mysql-result-set
(res-ptr (uffi:make-null-pointer 'mysql-mysql-res)
:type mysql-mysql-res-ptr-def)
- (full-set nil))
+ (field-types nil :type cons)
+ (full-set nil :type boolean))
(defmethod database-dump-result-set (result-set (database mysql-database))
(mysql-free-result (mysql-result-set-res-ptr result-set))
-(defmethod database-query (query-expression (database mysql-database))
+(defmethod database-query (query-expression (database mysql-database) field-types)
(with-slots (mysql-ptr) database
(uffi:with-cstring (query-native query-expression)
(if (zerop (mysql-query mysql-ptr query-native))
:error (mysql-error-string mysql-ptr))))))
-(defmethod database-query-result-set (query-expression
- (database mysql-database)
- &optional full-set)
+(defmethod database-query-result-set (query-expression (database mysql-database)
+ &key full-set field-types)
(uffi:with-cstring (query-native query-expression)
(let ((mysql-ptr (database-mysql-ptr database)))
(declare (type mysql-mysql-ptr-def mysql-ptr))
;;;; Original code by Pierre R. Mai
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: postgresql-socket-sql.cl,v 1.1 2002/03/23 14:04:53 kevin Exp $
+;;;; $Id: postgresql-socket-sql.cl,v 1.2 2002/03/24 18:08:27 kevin Exp $
;;;;
;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
(close-postgresql-connection (database-connection database))
t)
-(defmethod database-query (expression (database postgresql-socket-database))
+(defmethod database-query (expression (database postgresql-socket-database) field-types)
(let ((connection (database-connection database)))
(with-postgresql-handlers (database expression)
(start-query-execution connection expression)
:errno 'missing-result
:error "Didn't receive completion for command.")))))))
-(defmethod database-query-result-set
- (expression (database postgresql-socket-database) &optional full-set)
+(defstruct postgresql-socket-result-set
+ (done nil)
+ (cursor nil)
+ (field-types nil :type cons))
+
+(defmethod database-query-result-set (expression (database postgresql-socket-database)
+ &key full-set field-types
+ )
(declare (ignore full-set))
(let ((connection (database-connection database)))
(with-postgresql-handlers (database expression)
:expression expression
:errno 'missing-result
:error "Didn't receive result cursor for query."))
- (values (cons nil cursor)
+ (values (make-postgresql-socket-result-set
+ :done nil
+ :cursor cursor)
(length (postgresql-cursor-fields cursor)))))))
-(defmethod database-dump-result-set
- (result-set (database postgresql-socket-database))
- (if (car result-set)
+(defmethod database-dump-result-set (result-set
+ (database postgresql-socket-database))
+ (if (postgresql-socket-result-set-done result-set)
t
(with-postgresql-handlers (database)
- (loop while (skip-cursor-row (cdr result-set))
- finally (setf (car result-set) t)))))
-
-(defmethod database-store-next-row
- (result-set (database postgresql-socket-database) list)
- (let ((cursor (cdr result-set)))
+ (loop while (skip-cursor-row
+ (postgresql-socket-result-set-cursor result-set))
+ finally (setf (postgresql-socket-result-set-done result-set) t)))))
+
+(defmethod database-store-next-row (result-set
+ (database postgresql-socket-database)
+ list)
+ (let ((cursor (postgresql-socket-result-set-cursor result-set)))
(with-postgresql-handlers (database)
(if (copy-cursor-row cursor list)
t
(prog1 nil
- (setf (car result-set) t)
+ (setf (postgresql-socket-result-set-done result-set) t)
(wait-for-query-results (database-connection database)))))))
;;;; Original code by Pierre R. Mai
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: postgresql-sql.cl,v 1.2 2002/03/23 17:07:40 kevin Exp $
+;;;; $Id: postgresql-sql.cl,v 1.3 2002/03/24 18:08:27 kevin Exp $
;;;;
;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
(setf (database-conn-ptr database) nil)
t)
-(defmethod database-query (query-expression (database postgresql-database))
+(defmethod database-query (query-expression (database postgresql-database) field-types)
(let ((conn-ptr (database-conn-ptr database)))
(declare (type pgsql-conn-def conn-ptr))
(uffi:with-cstring (query-native query-expression)
(PQresultErrorMessage result)))))
(PQclear result))))))
-(defstruct postgresql-result-set
+(defstruct postgresql-result-sset
(res-ptr (uffi:make-null-pointer 'pgsql-result)
:type pgsql-result-def)
- (num-tuples 0)
- (num-fields 0)
- (tuple-index 0))
+ (field-types nil :type cons)
+ (num-tuples 0 :type integer)
+ (num-fields 0 :type integer)
+ (tuple-index 0 :type integer))
-(defmethod database-query-result-set (query-expression
- (database postgresql-database)
- &optional full-set)
+(defmethod database-query-result-set (query-expression (database postgresql-database)
+ &key full-set field-types)
(let ((conn-ptr (database-conn-ptr database)))
(declare (type pgsql-conn-def conn-ptr))
(uffi:with-cstring (query-native query-expression)
;;;; Original code by Pierre R. Mai
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: sql.cl,v 1.3 2002/03/24 04:37:09 kevin Exp $
+;;;; $Id: sql.cl,v 1.4 2002/03/24 18:08:27 kevin Exp $
;;;;
;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
;;; Basic operations on databases
-(defmethod query (query-expression &key (database *default-database*))
+(defmethod query (query-expression &key (database *default-database*)
+ field-types)
"Execute the SQL query expression query-expression on the given database.
Returns a list of lists of values of the result of that expression."
- (database-query query-expression database))
+ (database-query query-expression database field-types))
-(defgeneric database-query (query-expression database)
- (:method (query-expression (database closed-database))
- (declare (ignore query-expression))
+(defgeneric database-query (query-expression database field-types)
+ (:method (query-expression (database closed-database) field-types)
+ (declare (ignore query-expression field-types))
(signal-closed-database-error database))
(:documentation "Internal generic implementation of query."))
;;; Mapping and iteration
(defgeneric database-query-result-set
- (query-expression database &optional full-set)
- (:method (query-expression (database closed-database) &optional full-set)
- (declare (ignore query-expression full-set))
+ (query-expression database &key full-set field-types)
+ (:method (query-expression (database closed-database) &key full-set field-types)
+ (declare (ignore query-expression full-set field-types))
(signal-closed-database-error database)
(values nil nil nil))
(:documentation
(defun map-query (output-type-spec function query-expression
- &key (database *default-database*))
+ &key (database *default-database*)
+ (field-types nil))
"Map the function over all tuples that are returned by the query in
query-expression. The results of the function are collected as
specified in output-type-spec and returned like in MAP."
(macrolet ((type-specifier-atom (type)
`(if (atom ,type) ,type (car ,type))))
(case (type-specifier-atom output-type-spec)
- ((nil) (map-query-for-effect function query-expression database))
- (list (map-query-to-list function query-expression database))
+ ((nil)
+ (map-query-for-effect function query-expression database field-types))
+ (list
+ (map-query-to-list function query-expression database field-types))
((simple-vector simple-string vector string array simple-array
bit-vector simple-bit-vector base-string
simple-base-string)
- (map-query-to-simple output-type-spec
- function query-expression database))
+ (map-query-to-simple output-type-spec function query-expression database field-types))
(t
(funcall #'map-query (cmucl-compat:result-type-or-lose output-type-spec t)
- function query-expression :database database)))))
+ function query-expression :database database :field-types field-types)))))
-(defun map-query-for-effect (function query-expression database)
+(defun map-query-for-effect (function query-expression database field-types)
(multiple-value-bind (result-set columns)
- (database-query-result-set query-expression database)
+ (database-query-result-set query-expression database :full-set nil
+ :field-types field-types)
(when result-set
(unwind-protect
(do ((row (make-list columns)))
(apply function row))
(database-dump-result-set result-set database)))))
-(defun map-query-to-list (function query-expression database)
+(defun map-query-to-list (function query-expression database field-types)
(multiple-value-bind (result-set columns)
- (database-query-result-set query-expression database)
+ (database-query-result-set query-expression database :full-set nil
+ :field-types field-types)
(when result-set
(unwind-protect
(let ((result (list nil)))
(database-dump-result-set result-set database)))))
-(defun map-query-to-simple (output-type-spec function query-expression database)
+(defun map-query-to-simple (output-type-spec function query-expression database field-types)
(multiple-value-bind (result-set columns rows)
- (database-query-result-set query-expression database t)
+ (database-query-result-set query-expression database :full-set t :
+ field-types field-types)
(when result-set
(unwind-protect
(if rows
(database-dump-result-set result-set database)))))
(defmacro do-query (((&rest args) query-expression
- &key (database '*default-database*))
+ &key (database '*default-database*)
+ (field-types nil))
&body body)
(let ((result-set (gensym))
(columns (gensym))
(db (gensym)))
`(let ((,db ,database))
(multiple-value-bind (,result-set ,columns)
- (database-query-result-set ,query-expression ,db)
+ (database-query-result-set ,query-expression ,db
+ :full-set nil :field-types ,field-types)
(when ,result-set
(unwind-protect
(do ((,row (make-list ,columns)))