From: Kevin M. Rosenberg Date: Sun, 24 Mar 2002 18:10:16 +0000 (+0000) Subject: r1650: *** empty log message *** X-Git-Tag: v3.8.6~1224 X-Git-Url: http://git.kpe.io/?p=clsql.git;a=commitdiff_plain;h=01e78fad2d9c4c18f11ec032c80afa59212ba109 r1650: *** empty log message *** --- diff --git a/ChangeLog b/ChangeLog index d5f5b23..e8086df 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,11 @@ +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 diff --git a/doc/intro.sgml b/doc/intro.sgml index f2f0354..25c672e 100644 --- a/doc/intro.sgml +++ b/doc/intro.sgml @@ -29,7 +29,7 @@ are: compatibility layer for &cmucl; specific code. -improved robustness of the &mysql; back-end. +much improved robustness for the &mysql; back-end. improved system loading. diff --git a/interfaces/aodbc/aodbc-sql.cl b/interfaces/aodbc/aodbc-sql.cl index 4fb4f47..e3eedb5 100644 --- a/interfaces/aodbc/aodbc-sql.cl +++ b/interfaces/aodbc/aodbc-sql.cl @@ -7,7 +7,7 @@ ;;;; 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 ;;;; @@ -60,7 +60,7 @@ (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 () @@ -83,11 +83,11 @@ (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 diff --git a/interfaces/mysql/mysql-sql.cl b/interfaces/mysql/mysql-sql.cl index 878033c..804c5dc 100644 --- a/interfaces/mysql/mysql-sql.cl +++ b/interfaces/mysql/mysql-sql.cl @@ -8,7 +8,7 @@ ;;;; 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 @@ -98,7 +98,8 @@ (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)) @@ -133,7 +134,7 @@ -(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)) @@ -160,9 +161,8 @@ :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)) diff --git a/interfaces/postgresql-socket/postgresql-socket-sql.cl b/interfaces/postgresql-socket/postgresql-socket-sql.cl index 2654a89..1570a4e 100644 --- a/interfaces/postgresql-socket/postgresql-socket-sql.cl +++ b/interfaces/postgresql-socket/postgresql-socket-sql.cl @@ -8,7 +8,7 @@ ;;;; 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 @@ -110,7 +110,7 @@ (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) @@ -169,8 +169,14 @@ :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) @@ -184,23 +190,27 @@ :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))))))) diff --git a/interfaces/postgresql/postgresql-sql.cl b/interfaces/postgresql/postgresql-sql.cl index eca4b29..6dedf46 100644 --- a/interfaces/postgresql/postgresql-sql.cl +++ b/interfaces/postgresql/postgresql-sql.cl @@ -8,7 +8,7 @@ ;;;; 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 @@ -99,7 +99,7 @@ (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) @@ -161,16 +161,16 @@ (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) diff --git a/sql/sql.cl b/sql/sql.cl index 06431e4..c614f7e 100644 --- a/sql/sql.cl +++ b/sql/sql.cl @@ -8,7 +8,7 @@ ;;;; 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 @@ -308,14 +308,15 @@ database was disconnected and only one other connection exists." ;;; 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.")) @@ -332,9 +333,9 @@ Returns true on success or nil on failure." ;;; 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 @@ -369,7 +370,8 @@ returns nil when result-set is finished.")) (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." @@ -380,20 +382,22 @@ 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))) @@ -402,9 +406,10 @@ specified in output-type-spec and returned like in MAP." (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))) @@ -416,9 +421,10 @@ specified in output-type-spec and returned like in MAP." (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 @@ -450,7 +456,8 @@ specified in output-type-spec and returned like in MAP." (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)) @@ -458,7 +465,8 @@ specified in output-type-spec and returned like in MAP." (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)))