+2 May 2004 Marcus Pearce (m.t.pearce@city.ac.uk)
+ * sql/generics.lisp: add generic function for SELECT.
+ * sql/objects.lisp: make SELECT a method specialisation.
+ * sql/classes.lisp: MAKE-QUERY now calls SELECT if the selections
+ referred to are View Classes.
+ * base/basic-sql.lisp: in DO-QUERY and MAP-QUERY, if the
+ query-expression arg evaluates to a list, then we have an object
+ query.
+ * tests/test-oodml.lisp: add tests for DO-QUERY and MAP-QUERY with
+ object queries.
+ * TODO: remove items done and add a todo for SELECT.
+ * sql/objects.lisp: SELECT takes a :field-names arg to pass on to
+ QUERY.
+ * sql/sql.lisp: add :field-names arg to QUERY.
+ * tests/test-fdml.lisp: minor rework to use :field-names arg to
+ SELECT.
+
2 May 2004 Marcus Pearce (m.t.pearce@city.ac.uk)
* sql/objects.lisp: fix bug in FIND-ALL when SELECT called with 2
or more View Classes.
* port Oracle backend to UFFI.
* consider adding large object support to mysql and odbc
+* add support for prepared statements.
TESTS TO ADD
* CACHE-TABLE-QUERIES
-* :VOID-VALUE, use a new view-class with several fields with different void-values
-* :db-kind :key adds an index for that key, complicated by different
- backends show autogenerated primary key in different ways.
-* New universal and bigint types, add tests for other types
+* :VOID-VALUE attribute, use a new view-class with several fields with different void-values
+* :COLUMN attribute
+* Test that ":db-kind :key" adds an index for that key. This is complicated by different
+ backends showing autogenerated primary key in different ways.
+* Test New universal and bigint types, add tests for other types such as duration and money
* Large object testing
COMMONSQL SPEC
SELECT
o keyword arg :refresh should function as advertised
- o should return (values result-list field-names)
- o should coerce values returned as strings to appropriate lisp type
-
- QUERY
- o should coerce values returned as strings to appropriate lisp type
- for SQLite backend
+ o should accept type-modified database identifiers (e.g.,
+ [foo :string] which means that the values in column foo are returned
+ as Lisp strings)
>> The object-oriented sql interface
o get :target-slot working
o implement :retrieval :immediate
- DO-QUERY,MAP-QUERY,LOOP
+ LOOP
o should work with object queries as well as functional ones
-
>> Symbolic SQL syntax
o Complete sql expressions (see operations.lisp)
(defmacro do-query (((&rest args) query-expression
&key (database '*default-database*) (result-types nil))
&body body)
- "Repeatedly executes BODY within a binding of ARGS on the attributes
-of each record resulting from QUERY. The return value is determined by
-the result of executing BODY. The default value of DATABASE is
-*DEFAULT-DATABASE*."
+ "Repeatedly executes BODY within a binding of ARGS on the
+attributes of each record resulting from QUERY-EXPRESSION. The
+return value is determined by the result of executing BODY. The
+default value of DATABASE is *DEFAULT-DATABASE*."
(let ((result-set (gensym))
(columns (gensym))
(row (gensym))
(db (gensym)))
- `(let ((,db ,database))
- (multiple-value-bind (,result-set ,columns)
- (database-query-result-set ,query-expression ,db
- :full-set nil :result-types ,result-types)
- (when ,result-set
- (unwind-protect
- (do ((,row (make-list ,columns)))
- ((not (database-store-next-row ,result-set ,db ,row))
- nil)
- (destructuring-bind ,args ,row
- ,@body))
- (database-dump-result-set ,result-set ,db)))))))
+ `(if (listp ,query-expression)
+ ;; Object query
+ (dolist (,row ,query-expression)
+ (destructuring-bind ,args
+ ,row
+ ,@body))
+ ;; Functional query
+ (let ((,db ,database))
+ (multiple-value-bind (,result-set ,columns)
+ (database-query-result-set ,query-expression ,db
+ :full-set nil
+ :result-types ,result-types)
+ (when ,result-set
+ (unwind-protect
+ (do ((,row (make-list ,columns)))
+ ((not (database-store-next-row ,result-set ,db ,row))
+ nil)
+ (destructuring-bind ,args ,row
+ ,@body))
+ (database-dump-result-set ,result-set ,db))))))))
(defun map-query (output-type-spec function query-expression
&key (database *default-database*)
(result-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 result-types))
- (list
- (map-query-to-list function query-expression database result-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 result-types))
- (t
- (funcall #'map-query (cmucl-compat:result-type-or-lose output-type-spec t)
- function query-expression :database database :result-types result-types)))))
+ "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 (listp query-expression)
+ ;; Object query
+ (map output-type-spec #'(lambda (x) (apply function x)) query-expression)
+ ;; Functional query
+ (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
+ result-types))
+ (list
+ (map-query-to-list function query-expression database result-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 result-types))
+ (t
+ (funcall #'map-query
+ (cmucl-compat:result-type-or-lose output-type-spec t)
+ function query-expression :database database
+ :result-types result-types))))))
(defun map-query-for-effect (function query-expression database result-types)
(multiple-value-bind (result-set columns)
select-args)))
(defun make-query (&rest args)
- (multiple-value-bind (selections arglist)
- (query-get-selections args)
- (destructuring-bind (&key all flatp set-operation distinct from where
- group-by having order-by order-by-descending
- offset limit &allow-other-keys)
- arglist
- (if (null selections)
- (error "No target columns supplied to select statement."))
- (if (null from)
- (error "No source tables supplied to select statement."))
- (make-instance 'sql-query :selections selections
- :all all :flatp flatp :set-operation set-operation
- :distinct distinct :from from :where where
- :limit limit :offset offset
- :group-by group-by :having having :order-by order-by
- :order-by-descending order-by-descending))))
+ (flet ((select-objects (target-args)
+ (and target-args
+ (every #'(lambda (arg)
+ (and (symbolp arg)
+ (find-class arg nil)))
+ target-args))))
+ (multiple-value-bind (selections arglist)
+ (query-get-selections args)
+ (if (select-objects selections)
+ (apply #'select args)
+ (destructuring-bind (&key all flatp set-operation distinct from where
+ group-by having order-by order-by-descending
+ offset limit &allow-other-keys)
+ arglist
+ (if (null selections)
+ (error "No target columns supplied to select statement."))
+ (if (null from)
+ (error "No source tables supplied to select statement."))
+ (make-instance 'sql-query :selections selections
+ :all all :flatp flatp :set-operation set-operation
+ :distinct distinct :from from :where where
+ :limit limit :offset offset
+ :group-by group-by :having having :order-by order-by
+ :order-by-descending order-by-descending))))))
(defvar *in-subselect* nil)
(in-package #:clsql-sys)
+(defgeneric select (&rest args)
+ (:documentation
+ "The function SELECT selects data from DATABASE, which has a
+default value of *DEFAULT-DATABASE*, given the constraints
+specified by the rest of the ARGS. It returns a list of objects
+as specified by SELECTIONS. By default, the objects will each be
+represented as lists of attribute values. The argument SELECTIONS
+consists either of database identifiers, type-modified database
+identifiers or literal strings. A type-modifed database
+identifier is an expression such as [foo :string] which means
+that the values in column foo are returned as Lisp strings. The
+FLATP argument, which has a default value of nil, specifies if
+full bracketed results should be returned for each matched
+entry. If FLATP is nil, the results are returned as a list of
+lists. If FLATP is t, the results are returned as elements of a
+list, only if there is only one result per row. The arguments
+ALL, SET-OPERATION, DISTINCT, FROM, WHERE, GROUP-BY, HAVING and
+ORDER-by have the same function as the equivalent SQL expression.
+The SELECT function is common across both the functional and
+object-oriented SQL interfaces. If selections refers to View
+Classes then the select operation becomes object-oriented. This
+means that SELECT returns a list of View Class instances, and
+SLOT-VALUE becomes a valid SQL operator for use within the where
+clause. In the View Class case, a second equivalent select call
+will return the same View Class instance objects. If REFRESH is
+true, then existing instances are updated if necessary, and in
+this case you might need to extend the hook INSTANCE-REFRESHED.
+The default value of REFRESH is nil. SQL expressions used in the
+SELECT function are specified using the square bracket syntax,
+once this syntax has been enabled using
+ENABLE-SQL-READER-SYNTAX."))
+
(defgeneric update-record-from-slot (object slot &key database)
(:documentation
"The generic function UPDATE-RECORD-FROM-SLOT updates an individual
(defmethod instance-refreshed ((instance standard-db-object)))
-(defun select (&rest select-all-args)
+(defmethod select (&rest select-all-args)
"Selects data from database given the constraints specified. Returns
a list of lists of record values as specified by select-all-args. By
default, the records are each represented as lists of attribute
(let ((expr (apply #'make-query select-all-args)))
(destructuring-bind (&key (flatp nil)
(result-types :auto)
+ (field-names t)
(database *default-database*)
&allow-other-keys)
qualifier-args
(query expr :flatp flatp :result-types result-types
- :database database)))))))
+ :field-names field-names :database database)))))))
(defmethod query ((expr %sql-expression) &key (database *default-database*)
- (result-types nil) (flatp nil))
+ (result-types nil) (flatp nil) (field-names t))
(query (sql-output expr database) :database database :flatp flatp
- :result-types result-types))
+ :result-types result-types :field-names field-names))
(defun truncate-database (&key (database *default-database*))
(unless (typep database 'database)
(destructuring-bind (int float bigint str) row
(push (list (integerp int)
(typep float 'double-float)
- (if (member *test-database-type* '(:odbc :aodbc))
- t
- (integerp bigint))
+ (integerp bigint)
(stringp str))
results))))
((t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t)))
t)
(deftest :fdml/select/2
- (values (clsql:select [first-name] :from [employee] :flatp t :distinct t
- :result-types nil
- :order-by [first-name]))
+ (clsql:select [first-name] :from [employee] :flatp t :distinct t
+ :field-names nil
+ :result-types nil
+ :order-by [first-name])
("Boris" "Josef" "Konstantin" "Leon" "Leonid" "Mikhail" "Nikita" "Vladamir"
"Yuri"))
(deftest :fdml/select/3
- (values (clsql:select [first-name] [count [*]] :from [employee]
+ (clsql:select [first-name] [count [*]] :from [employee]
:result-types nil
:group-by [first-name]
- :order-by [first-name]))
+ :order-by [first-name]
+ :field-names nil)
(("Boris" "1") ("Josef" "1") ("Konstantin" "1") ("Leon" "1") ("Leonid" "1")
("Mikhail" "1") ("Nikita" "1") ("Vladamir" "2") ("Yuri" "1")))
(deftest :fdml/select/4
- (values (clsql:select [last-name] :from [employee]
+ (clsql:select [last-name] :from [employee]
:where [like [email] "%org"]
:order-by [last-name]
+ :field-names nil
:result-types nil
- :flatp t))
+ :flatp t)
("Andropov" "Brezhnev" "Chernenko" "Gorbachev" "Kruschev" "Lenin" "Putin"
"Stalin" "Trotsky" "Yeltsin"))
(deftest :fdml/select/5
- (values (clsql:select [email] :from [employee] :flatp t :result-types nil
+ (clsql:select [email] :from [employee] :flatp t :result-types nil
:where [in [employee emplid]
- [select [managerid] :from [employee]]]))
- ("lenin@soviet.org"))
+ [select [managerid] :from [employee]]]
+ :field-names nil)
+ ("lenin@soviet.org"))
(deftest :fdml/select/6
(if (db-type-has-fancy-math? *test-database-underlying-type*)
(mapcar #'(lambda (s) (parse-integer s :junk-allowed t))
(clsql:select [function "trunc" [height]] :from [employee]
:result-types nil
+ :field-names nil
:flatp t))
(mapcar #'(lambda (s) (truncate (parse-integer s :junk-allowed t)))
(clsql:select [height] :from [employee] :flatp t
- :result-types nil)))
+ :field-names nil :result-types nil)))
(1 1 1 1 1 1 1 1 1 1))
(deftest :fdml/select/7
- (values
- (clsql:select [max [emplid]] :from [employee] :flatp t :result-types nil))
- ("10"))
+ (clsql:select [max [emplid]] :from [employee] :flatp t
+ :field-names nil :result-types nil)
+ ("10"))
(deftest :fdml/select/8
- (values
- (clsql:select [min [emplid]] :from [employee] :flatp t :result-types nil))
- ("1"))
+ (clsql:select [min [emplid]] :from [employee] :flatp t
+ :field-names nil :result-types nil)
+ ("1"))
(deftest :fdml/select/9
(subseq
(car
- (clsql:select [avg [emplid]] :from [employee] :flatp t :result-types nil))
+ (clsql:select [avg [emplid]] :from [employee] :flatp t
+ :field-names nil :result-types nil))
0 3)
- "5.5")
+ "5.5")
(deftest :fdml/select/10
- (values (clsql:select [last-name] :from [employee]
- :where [not [in [emplid]
- [select [managerid] :from [company]]]]
- :result-types nil
- :flatp t
- :order-by [last-name]))
+ (clsql:select [last-name] :from [employee]
+ :where [not [in [emplid]
+ [select [managerid] :from [company]]]]
+ :result-types nil
+ :field-names nil
+ :flatp t
+ :order-by [last-name])
("Andropov" "Brezhnev" "Chernenko" "Gorbachev" "Kruschev" "Putin" "Stalin"
"Trotsky" "Yeltsin"))
(deftest :fdml/select/11
- (values (clsql:select [last-name] :from [employee] :where [married] :flatp t
- :order-by [emplid] :result-types nil))
- ("Lenin" "Stalin" "Trotsky"))
+ (clsql:select [last-name] :from [employee] :where [married] :flatp t
+ :field-names nil :order-by [emplid] :result-types nil)
+ ("Lenin" "Stalin" "Trotsky"))
(deftest :fdml/select/12
(let ((v 1))
- (values (clsql:select [last-name] :from [employee] :where [= [emplid] v]
- :result-types nil)))
- (("Lenin")))
+ (clsql:select [last-name] :from [employee] :where [= [emplid] v]
+ :field-names nil :result-types nil))
+ (("Lenin")))
(deftest :fdml/select/13
(multiple-value-bind (results field-names)
(deftest :fdml/select/14
(floatp (car (clsql:select [height] :from [employee] :where [= [emplid] 1]
:flatp t)))
- t)
+ t)
;(deftest :fdml/select/11
; (clsql:select [emplid] :from [employee]
"lenin@soviet.org" "lenin-nospam@soviet.org" "lenin@soviet.org")
-;(deftest :oodml/iteration/1
-; (clsql:do-query ((e) [select 'clsql-tests::employee :where [married]
-; :order-by [emplid]])
-; (slot-value e last-name))
-; ("Lenin" "Stalin" "Trotsky"))
+(deftest :oodml/do-query/1
+ (let ((result '()))
+ (clsql:do-query ((e) [select 'employee :order-by [emplid]])
+ (push (slot-value e 'last-name) result))
+ result)
+ ("Putin" "Yeltsin" "Gorbachev" "Chernenko" "Andropov" "Brezhnev" "Kruschev"
+ "Trotsky" "Stalin" "Lenin"))
-;(deftest :oodml/iteration/2
-; (clsql:map-query 'list #'last-name [select 'employee :where [married]
-; :order-by [emplid]])
-; ("Lenin" "Stalin" "Trotsky"))
+(deftest :oodml/do-query/2
+ (let ((result '()))
+ (clsql:do-query ((e c) [select 'employee 'company
+ :where [= [slot-value 'employee 'last-name]
+ "Lenin"]])
+ (push (list (slot-value e 'last-name) (slot-value c 'name))
+ result))
+ result)
+ (("Lenin" "Widgets Inc.")))
+
+(deftest :oodml/map-query/1
+ (clsql:map-query 'list #'last-name [select 'employee :order-by [emplid]])
+ ("Lenin" "Stalin" "Trotsky" "Kruschev" "Brezhnev" "Andropov" "Chernenko"
+ "Gorbachev" "Yeltsin" "Putin"))
+
+(deftest :oodml/map-query/2
+ (clsql:map-query 'list #'(lambda (e c) (list (slot-value e 'last-name)
+ (slot-value c 'name)))
+ [select 'employee 'company :where [= [slot-value 'employee 'last-name]
+ "Lenin"]])
+ (("Lenin" "Widgets Inc.")))
;(deftest :oodml/iteration/3
; (loop for (e) being the tuples in
impl-version
machine-type)
form
+ (declare (ignoreable utime impl-version))
(if failed-tests
(format output "~&~A: ~D of ~D tests failed (~A, ~A).~&"
(db-title db-type underlying-db-type)
projects / clsql.git / commitdiff