Got :auto types working
* interfaces/postgresql/postgresql-api.cl
+ * interfaces/postgresql-socket/postgresql-socket-api.cl
Added pgsql-field-types enum
Got :auto types working
-; * multiple-files
-; Renamed :field-types to :types
+ * multiple-files
+ Renamed :field-types to :types
24 Mar 2002 Kevin Rosenberg (kevin@rosenberg.net)
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: aodbc-sql.cl,v 1.5 2002/03/25 06:07:06 kevin Exp $
+;;;; $Id: aodbc-sql.cl,v 1.6 2002/03/25 23:48:46 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) field-types)
+(defmethod database-query (query-expression (database aodbc-database) types)
(handler-case
(dbi:sql query-expression :db (database-aodbc-conn database)
- :types field-types)
+ :types types)
(error ()
(error 'clsql-sql-error
:database database
(defstruct aodbc-result-set
(query nil)
- (field-types nil :type cons)
+ (types nil :type cons)
(full-set nil :type boolean))
(defmethod database-query-result-set (query-expression (database aodbc-database)
- &key full-set field-types)
+ &key full-set types)
(handler-case
(multiple-value-bind (query column-names)
(dbi:sql query-expression
:row-count nil
:column-names t
:query t
- :types field-types
+ :types types
)
(values
(make-aodbc-result-set :query query :full-set full-set
- :field-types field-types)
+ :types types)
(length column-names)
nil ;; not able to return number of rows with aodbc
))
;;;; Original code by Pierre R. Mai
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: mysql-sql.cl,v 1.9 2002/03/25 14:26:23 kevin Exp $
+;;;; $Id: mysql-sql.cl,v 1.10 2002/03/25 23:48:46 kevin Exp $
;;;;
;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
;;; Field conversion functions
-(defun canonicalize-field-types (types num-fields res-ptr)
+(defun canonicalize-types (types num-fields res-ptr)
(cond
((if (listp types)
(let ((length-types (length types))
(defmethod database-query (query-expression (database mysql-database)
- field-types)
+ types)
(with-slots (mysql-ptr) database
(uffi:with-cstring (query-native query-expression)
(if (zerop (mysql-query mysql-ptr query-native))
(let ((res-ptr (mysql-use-result mysql-ptr)))
(if res-ptr
(let ((num-fields (mysql-num-fields res-ptr)))
- (setq field-types (canonicalize-field-types
- field-types num-fields
+ (setq types (canonicalize-types
+ types num-fields
res-ptr))
(unwind-protect
(loop for row = (mysql-fetch-row res-ptr)
(defstruct mysql-result-set
(res-ptr (uffi:make-null-pointer 'mysql-mysql-res)
:type mysql-mysql-res-ptr-def)
- (field-types nil)
+ (types nil)
(num-fields nil :type fixnum)
(full-set nil :type boolean))
(defmethod database-query-result-set (query-expression
(database mysql-database)
- &key full-set field-types)
+ &key full-set types)
(uffi:with-cstring (query-native query-expression)
(let ((mysql-ptr (database-mysql-ptr database)))
(declare (type mysql-mysql-ptr-def mysql-ptr))
:res-ptr res-ptr
:num-fields num-fields
:full-set full-set
- :field-types
- (canonicalize-field-types
- field-types num-fields
+ :types
+ (canonicalize-types
+ types num-fields
res-ptr))))
(if full-set
(values result-set
(defmethod database-store-next-row (result-set (database mysql-database) list)
(let* ((res-ptr (mysql-result-set-res-ptr result-set))
(row (mysql-fetch-row res-ptr))
- (field-types (mysql-result-set-field-types result-set)))
+ (types (mysql-result-set-types result-set)))
(declare (type mysql-mysql-res-ptr-def res-ptr)
(type mysql-row-def row))
(unless (uffi:null-pointer-p row)
(setf (car rest)
(convert-raw-field
(uffi:deref-array row 'mysql-row i)
- field-types
+ types
i)))
list)))
;;;;
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: postgresql-socket-api.cl,v 1.4 2002/03/25 23:30:49 kevin Exp $
+;;;; $Id: postgresql-socket-api.cl,v 1.5 2002/03/25 23:48:46 kevin Exp $
;;;;
;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
(t
result))))
-(defun read-cursor-row (cursor field-types)
+(defun read-field2 (socket type)
+ (let* ((length (read-socket-value 'int32 socket)))
+ (case type
+ (:int
+ (read-integer-from-socket socket length))
+ (:double
+ (read-double-from-socket socket length))
+ (t
+ (let ((result (make-string (- length 4))))
+ (read-socket-sequence result socket)
+ result)))))
+
+(defun read-integer-from-socket (socket length)
+ (let ((val 0)
+ (first-char (read-byte socket))
+ (negative nil))
+ (if (eql first-char (char-code #\-))
+ (setq negative t)
+ (setq val (- first-char (char-code #\0))))
+ (dotimes (i (1- length))
+ (setq val (+
+ (* 10 val)
+ (- (read-byte socket) (char-code #\0)))))
+ (if negative
+ (- 0 val)
+ val)))
+
+
+
+(defun read-cursor-row (cursor types)
(let* ((connection (postgresql-cursor-connection cursor))
(socket (postgresql-connection-socket connection))
(fields (postgresql-cursor-fields cursor)))
collect nil
else
collect
- (read-field socket (nth i field-types)))))
+ (read-field socket (nth i types)))))
(#.+binary-row-message+
(error "NYI"))
(#.+completed-response-message+
(funcall func (elt seq i) i)))
result-seq)
-(defun copy-cursor-row (cursor sequence field-types)
+(defun copy-cursor-row (cursor sequence types)
(let* ((connection (postgresql-cursor-connection cursor))
(socket (postgresql-connection-socket connection))
(fields (postgresql-cursor-fields cursor)))
(declare (fixnum i))
(if (zerop (elt null-vector i))
(setf (elt sequence i) nil)
- (let ((value (read-field socket (nth i field-types))))
+ (let ((value (read-field socket (nth i types))))
(setf (elt sequence i) value)))))
(map-into-indexed
sequence
#'(lambda (null-bit i)
(if (zerop null-bit)
nil
- (read-field socket (nth i field-types))))
+ (read-field socket (nth i types))))
(read-null-bit-vector socket (length sequence)))))
(#.+binary-row-message+
(error "NYI"))
(error 'postgresql-fatal-error :connection connection
:message "Received garbled message from backend")))))))
-(defun run-query (connection query &optional (field-types nil))
+(defun run-query (connection query &optional (types nil))
(start-query-execution connection query)
(multiple-value-bind (status cursor)
(wait-for-query-results connection)
(assert (eq status :cursor))
- (loop for row = (read-cursor-row cursor field-types)
+ (loop for row = (read-cursor-row cursor types)
while row
collect row
finally
;;;; Original code by Pierre R. Mai
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: postgresql-socket-sql.cl,v 1.5 2002/03/25 23:22:07 kevin Exp $
+;;;; $Id: postgresql-socket-sql.cl,v 1.6 2002/03/25 23:48:46 kevin Exp $
;;;;
;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
(otherwise
t))))
-(defun canonicalize-field-types (types cursor)
+(defun canonicalize-types (types cursor)
(let* ((fields (postgresql-cursor-fields cursor))
(num-fields (length fields)))
(cond
(close-postgresql-connection (database-connection database))
t)
-(defmethod database-query (expression (database postgresql-socket-database) field-types)
+(defmethod database-query (expression (database postgresql-socket-database) types)
(let ((connection (database-connection database)))
(with-postgresql-handlers (database expression)
(start-query-execution connection expression)
:expression expression
:errno 'missing-result
:error "Didn't receive result cursor for query."))
- (setq field-types (canonicalize-field-types field-types cursor))
- (loop for row = (read-cursor-row cursor field-types)
+ (setq types (canonicalize-types types cursor))
+ (loop for row = (read-cursor-row cursor types)
while row
collect row
finally
(defstruct postgresql-socket-result-set
(done nil)
(cursor nil)
- (field-types nil))
+ (types nil))
(defmethod database-query-result-set (expression (database postgresql-socket-database)
- &key full-set field-types
+ &key full-set types
)
(declare (ignore full-set))
(let ((connection (database-connection database)))
(values (make-postgresql-socket-result-set
:done nil
:cursor cursor
- :field-types (canonicalize-field-types field-types cursor))
+ :types (canonicalize-types types cursor))
(length (postgresql-cursor-fields cursor)))))))
(defmethod database-dump-result-set (result-set
(with-postgresql-handlers (database)
(if (copy-cursor-row cursor
list
- (postgresql-socket-result-set-field-types
+ (postgresql-socket-result-set-types
result-set))
t
(prog1 nil
;;;; Original code by Pierre R. Mai
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: postgresql-sql.cl,v 1.8 2002/03/25 14:13:41 kevin Exp $
+;;;; $Id: postgresql-sql.cl,v 1.9 2002/03/25 23:48:46 kevin Exp $
;;;;
;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
;;; Field conversion functions
-(defun canonicalize-field-types (types num-fields res-ptr)
+(defun canonicalize-types (types num-fields res-ptr)
(cond
((if (listp types)
(let ((length-types (length types))
(setf (database-conn-ptr database) nil)
t)
-(defmethod database-query (query-expression (database postgresql-database) field-types)
+(defmethod database-query (query-expression (database postgresql-database) types)
(let ((conn-ptr (database-conn-ptr database)))
(declare (type pgsql-conn-def conn-ptr))
(uffi:with-cstring (query-native query-expression)
nil)
(#.pgsql-exec-status-type#tuples-ok
(let ((num-fields (PQnfields result)))
- (setq field-types
- (canonicalize-field-types field-types num-fields
+ (setq types
+ (canonicalize-types types num-fields
result))
(loop for tuple-index from 0 below (PQntuples result)
collect
(if (zerop (PQgetisnull result tuple-index i))
(convert-raw-field
(PQgetvalue result tuple-index i)
- field-types i)
+ types i)
nil)))))
(t
(error 'clsql-sql-error
(defstruct postgresql-result-set
(res-ptr (uffi:make-null-pointer 'pgsql-result)
:type pgsql-result-def)
- (field-types nil)
+ (types nil)
(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)
- &key full-set field-types)
+ &key full-set types)
(let ((conn-ptr (database-conn-ptr database)))
(declare (type pgsql-conn-def conn-ptr))
(uffi:with-cstring (query-native query-expression)
:res-ptr result
:num-fields (PQnfields result)
:num-tuples (PQntuples result)
- :field-types (canonicalize-field-types
- field-types
+ :types (canonicalize-types
+ types
(PQnfields result)
result))))
(if full-set
(defmethod database-store-next-row (result-set (database postgresql-database)
list)
(let ((result (postgresql-result-set-res-ptr result-set))
- (field-types (postgresql-result-set-field-types result-set)))
+ (types (postgresql-result-set-types result-set)))
(declare (type pgsql-result-def result))
(if (>= (postgresql-result-set-tuple-index result-set)
(postgresql-result-set-num-tuples result-set))
(if (zerop (PQgetisnull result tuple-index i))
(convert-raw-field
(PQgetvalue result tuple-index i)
- field-types i)
+ types i)
nil))
finally
(incf (postgresql-result-set-tuple-index result-set))
;;;; Original code by Pierre R. Mai
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: sql.cl,v 1.5 2002/03/24 22:25:51 kevin Exp $
+;;;; $Id: sql.cl,v 1.6 2002/03/25 23:48:46 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*)
- field-types)
+ 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 field-types))
+ (database-query query-expression database types))
-(defgeneric database-query (query-expression database field-types)
- (:method (query-expression (database closed-database) field-types)
- (declare (ignore query-expression field-types))
+(defgeneric database-query (query-expression database types)
+ (:method (query-expression (database closed-database) types)
+ (declare (ignore query-expression types))
(signal-closed-database-error database))
(:documentation "Internal generic implementation of query."))
;;; Mapping and iteration
(defgeneric database-query-result-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))
+ (query-expression database &key full-set types)
+ (:method (query-expression (database closed-database) &key full-set types)
+ (declare (ignore query-expression full-set types))
(signal-closed-database-error database)
(values nil nil nil))
(:documentation
(defun map-query (output-type-spec function query-expression
&key (database *default-database*)
- (field-types nil))
+ (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."
`(if (atom ,type) ,type (car ,type))))
(case (type-specifier-atom output-type-spec)
((nil)
- (map-query-for-effect function query-expression database field-types))
+ (map-query-for-effect function query-expression database types))
(list
- (map-query-to-list function query-expression database field-types))
+ (map-query-to-list function query-expression database 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 field-types))
+ (map-query-to-simple output-type-spec function query-expression database types))
(t
(funcall #'map-query (cmucl-compat:result-type-or-lose output-type-spec t)
- function query-expression :database database :field-types field-types)))))
+ function query-expression :database database :types types)))))
-(defun map-query-for-effect (function query-expression database field-types)
+(defun map-query-for-effect (function query-expression database types)
(multiple-value-bind (result-set columns)
(database-query-result-set query-expression database :full-set nil
- :field-types field-types)
+ :types 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 field-types)
+(defun map-query-to-list (function query-expression database types)
(multiple-value-bind (result-set columns)
(database-query-result-set query-expression database :full-set nil
- :field-types field-types)
+ :types 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 field-types)
+(defun map-query-to-simple (output-type-spec function query-expression database types)
(multiple-value-bind (result-set columns rows)
(database-query-result-set query-expression database :full-set t
- :field-types field-types)
+ :types types)
(when result-set
(unwind-protect
(if rows
(defmacro do-query (((&rest args) query-expression
&key (database '*default-database*)
- (field-types nil))
+ (types nil))
&body body)
(let ((result-set (gensym))
(columns (gensym))
`(let ((,db ,database))
(multiple-value-bind (,result-set ,columns)
(database-query-result-set ,query-expression ,db
- :full-set nil :field-types ,field-types)
+ :full-set nil :types ,types)
(when ,result-set
(unwind-protect
(do ((,row (make-list ,columns)))
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Mar 2002
;;;;
-;;;; $Id: test-clsql.cl,v 1.7 2002/03/25 23:22:07 kevin Exp $
+;;;; $Id: test-clsql.cl,v 1.8 2002/03/25 23:48:46 kevin Exp $
;;;;
;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
(create-test-table db)
(pprint (clsql:query "select * from test_clsql"
:database db
- :field-types :auto))
+ :types :auto))
(pprint (clsql:map-query 'vector #'list "select * from test_clsql"
:database db
- :field-types :auto)) ;;'(:int :double t)))
+ :types :auto)) ;;'(:int :double t)))
(drop-test-table db))
(clsql:disconnect :database db)))
)
(format nil "INSERT INTO test_clsql VALUES (~d,~d,'~a')"
i (sqrt i) (format nil "~d" (sqrt i)))
db))
- (let ((res (clsql-mysql::database-query-result-set "select * from test_clsql" db :full-set t :field-types nil)))
+ (let ((res (clsql-mysql::database-query-result-set "select * from test_clsql" db :full-set t :types nil)))
(format t "~&Number rows: ~D~%" (mysql:mysql-num-rows (clsql-mysql::mysql-result-set-res-ptr res)))
(clsql-mysql::database-dump-result-set res db))
(clsql-mysql::database-execute-command "DROP TABLE test_clsql" db)
projects / clsql.git / commitdiff