projects
/
clsql.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
r1684: *** empty log message ***
[clsql.git]
/
sql
/
sql.cl
diff --git
a/sql/sql.cl
b/sql/sql.cl
index ce3cc56376d2eca6ce991965d2442ad4b2d28259..a0fc83315979adc7bc549abdc7b02ae4f33866ba 100644
(file)
--- a/
sql/sql.cl
+++ b/
sql/sql.cl
@@
-8,7
+8,7
@@
;;;; Original code by Pierre R. Mai
;;;; Date Started: Feb 2002
;;;;
;;;; Original code by Pierre R. Mai
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: sql.cl,v 1.
2 2002/03/24 04:01:26
kevin Exp $
+;;;; $Id: sql.cl,v 1.
7 2002/03/26 14:11:59
kevin Exp $
;;;;
;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
;;;;
;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
@@
-21,10
+21,13
@@
(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
(in-package :clsql-sys)
(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
(in-package :clsql-sys)
-;;;; Modified to use CMUCL-COMPAT library and to fix format strings in
-;;;; error messages
+;;; Modified by KMR
+;;; - to use CMUCL-COMPAT library
+;;; - fix format strings in error messages
+;;; - use field types
-;;;; Simple implementation of SQL along the lines of Harlequin's Common SQL
+
+;;; Simple implementation of SQL along the lines of Harlequin's Common SQL
;;; Conditions
(define-condition clsql-condition ()
;;; Conditions
(define-condition clsql-condition ()
@@
-148,10
+151,6
@@
although there is an existing connection (~A)."
(defvar *loaded-database-types* nil
"Contains a list of database types which have been defined/loaded.")
(defvar *loaded-database-types* nil
"Contains a list of database types which have been defined/loaded.")
-(defvar *library-loaded-database-types* nil
- "Contains a list of database types which have had their
-foreign libraries loaded successfully.")
-
(defun reload-database-types ()
"Reloads any foreign code for the loaded database types after a dump."
(mapc #'database-type-load-foreign *loaded-database-types*))
(defun reload-database-types ()
"Reloads any foreign code for the loaded database types after a dump."
(mapc #'database-type-load-foreign *loaded-database-types*))
@@
-165,9
+164,7
@@
foreign libraries loaded successfully.")
(defgeneric database-type-library-loaded (database-type)
(:documentation
"The internal generic implementation for checking if
(defgeneric database-type-library-loaded (database-type)
(:documentation
"The internal generic implementation for checking if
-database type library loaded successfully.")
- (:method :after (database-type)
- (pushnew database-type *library-loaded-database-types*)))
+database type library loaded successfully."))
(defvar *default-database-type* nil
"Specifies the default type of database. Currently only :mysql is
(defvar *default-database-type* nil
"Specifies the default type of database. Currently only :mysql is
@@
-314,14
+311,15
@@
database was disconnected and only one other connection exists."
;;; Basic operations on databases
;;; Basic operations on databases
-(defmethod query (query-expression &key (database *default-database*))
+(defmethod query (query-expression &key (database *default-database*)
+ 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."
"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
types
))
-(defgeneric database-query (query-expression database)
- (:method (query-expression (database closed-database))
- (declare (ignore query-expression))
+(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."))
(signal-closed-database-error database))
(:documentation "Internal generic implementation of query."))
@@
-338,9
+336,9
@@
Returns true on success or nil on failure."
;;; Mapping and iteration
(defgeneric database-query-result-set
;;; 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 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
(signal-closed-database-error database)
(values nil nil nil))
(:documentation
@@
-375,7
+373,8
@@
returns nil when result-set is finished."))
(defun map-query (output-type-spec function query-expression
(defun map-query (output-type-spec function query-expression
- &key (database *default-database*))
+ &key (database *default-database*)
+ (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."
"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."
@@
-386,20
+385,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)
(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 types))
+ (list
+ (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)
((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 types))
(t
(funcall #'map-query (cmucl-compat:result-type-or-lose output-type-spec t)
(t
(funcall #'map-query (cmucl-compat:result-type-or-lose output-type-spec t)
- function query-expression :database database)))))
+ function query-expression :database database
:types types
)))))
-(defun map-query-for-effect (function query-expression database)
+(defun map-query-for-effect (function query-expression database
types
)
(multiple-value-bind (result-set columns)
(multiple-value-bind (result-set columns)
- (database-query-result-set query-expression database)
+ (database-query-result-set query-expression database :full-set nil
+ :types types)
(when result-set
(unwind-protect
(do ((row (make-list columns)))
(when result-set
(unwind-protect
(do ((row (make-list columns)))
@@
-408,9
+409,10
@@
specified in output-type-spec and returned like in MAP."
(apply function row))
(database-dump-result-set result-set database)))))
(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
types
)
(multiple-value-bind (result-set columns)
(multiple-value-bind (result-set columns)
- (database-query-result-set query-expression database)
+ (database-query-result-set query-expression database :full-set nil
+ :types types)
(when result-set
(unwind-protect
(let ((result (list nil)))
(when result-set
(unwind-protect
(let ((result (list nil)))
@@
-422,9
+424,10
@@
specified in output-type-spec and returned like in MAP."
(database-dump-result-set result-set database)))))
(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
types
)
(multiple-value-bind (result-set columns rows)
(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
+ :types types)
(when result-set
(unwind-protect
(if rows
(when result-set
(unwind-protect
(if rows
@@
-456,7
+459,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
(database-dump-result-set result-set database)))))
(defmacro do-query (((&rest args) query-expression
- &key (database '*default-database*))
+ &key (database '*default-database*)
+ (types nil))
&body body)
(let ((result-set (gensym))
(columns (gensym))
&body body)
(let ((result-set (gensym))
(columns (gensym))
@@
-464,7
+468,8
@@
specified in output-type-spec and returned like in MAP."
(db (gensym)))
`(let ((,db ,database))
(multiple-value-bind (,result-set ,columns)
(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 :types ,types)
(when ,result-set
(unwind-protect
(do ((,row (make-list ,columns)))
(when ,result-set
(unwind-protect
(do ((,row (make-list ,columns)))