15 May 2004 Marcus Pearce (m.t.pearce@city.ac.uk)
- * sql/classes.lisp: SELECT now accepts table identifiers as strings
- for CommonSQL compliance. Add support for qualified sql identifiers
- with aliased table names.
- * tests/test-fdml.lisp: added tests for table identifiers as strings
- in SELECT and for aliased definitions.
- * tests/test-syntax.lisp: added tests for alias definitions.
-
+ * sql/operations.lisp: make MINUS operator a synonym for EXCEPT. Add
+ COALESCE operator and make NVL a synonym for this. Make ANY, SOME,
+ ALL and EXISTS generate function expressions so they output the
+ correct SQL.
+ * sql/classes.lisp: SELECT now generates appropriate SQL when
+ passed the SET-OPERATION and ALL keyword arguments.
+ * sql/classes.lisp: the ORDER-BY keyword argument to SELECT now
+ accepts ordering constraints as pairs of the form (column direction)
+ where direction may be :ASC or :DESC.
+ * tests/test-syntax.lisp: added tests for MINUS and COALESCE/NVL.
+ Correct tests for ANY, SOME, ALL and EXISTS.
+ * tests/test-fdml.lisp: added test for COALESCE.
+ * sql/sql.lisp: MAP-QUERY now applies FUNCTION to QUERY-EXPRESSION
+ using funcall unless QUERY-EXPRESSION returns one column and its
+ FLATP slot is not nil in which case apply is used.
+ * tests/test-basic.lisp: modified calls to MAP-QUERY to reflect the
+ changes.
+ * TODO: remove items done.
+ * db-postgresql/postgresql-sql.lisp: no need to reverse results in
+ DATABASE-LIST-ATTRIBUTES.
+ * db-postgresql-socket/postgresql-socket-sql.lisp: no need to reverse
+ results in DATABASE-LIST-ATTRIBUTES.
+
+15 May 2004 Marcus Pearce (m.t.pearce@city.ac.uk)
+ * sql/classes.lisp: SELECT now accepts table identifiers as strings
+ for CommonSQL compliance. Add support for qualified sql identifiers
+ with aliased table names.
+ * tests/test-fdml.lisp: added tests for table identifiers as strings
+ in SELECT and for aliased definitions.
+ * tests/test-syntax.lisp: added tests for alias definitions.
+
15 May 2004 Marcus Pearce (m.t.pearce@city.ac.uk)
* sql/sql.lisp: PRINT-QUERY now calls QUERY with result-types and
field-names set to nil.
>> Symbolic SQL syntax
- o Complete sql expressions (see operations.lisp)
-
- nvl (Oracle specific)
- userenv (Oracle specific)
- minus (Oracle specific: does the same as EXCEPT)
-
- o variables (e.g., table identifiers) should be instantiated at runtime
-
+ o userenv (Oracle specific but deprecated in Oracle 9)
VARIANCES FROM COMMONSQL
owner-clause)
database nil nil))))
(if result
- (reverse
- (remove-if #'(lambda (it) (member it '("cmin"
- "cmax"
- "xmax"
- "xmin"
- "oid"
- "ctid"
- ;; kmr -- added tableoid
- "tableoid") :test #'equal))
- result)))))
+ (remove-if #'(lambda (it) (member it '("cmin"
+ "cmax"
+ "xmax"
+ "xmin"
+ "oid"
+ "ctid"
+ ;; kmr -- added tableoid
+ "tableoid") :test #'equal))
+ result))))
(defmethod database-attribute-type (attribute (table string)
(database postgresql-socket-database)
owner-clause)
database nil nil))))
(if result
- (reverse
- (remove-if #'(lambda (it) (member it '("cmin"
- "cmax"
- "xmax"
- "xmin"
- "oid"
- "ctid"
- ;; kmr -- added tableoid
- "tableoid") :test #'equal))
- result)))))
+ (remove-if #'(lambda (it) (member it '("cmin"
+ "cmax"
+ "xmax"
+ "xmin"
+ "oid"
+ "ctid"
+ ;; kmr -- added tableoid
+ "tableoid") :test #'equal))
+ result))))
(defmethod database-attribute-type (attribute (table string)
(database postgresql-database)
(let ((subs (if (consp (car sub-expressions))
(car sub-expressions)
sub-expressions)))
+ (when (= (length subs) 1)
+ (output-sql operator database)
+ (write-char #\Space *sql-stream*))
(do ((sub subs (cdr sub)))
((null (cdr sub)) (output-sql (car sub) database))
(output-sql (car sub) database)
(defmethod output-sql ((query sql-query) database)
(with-slots (distinct selections from where group-by having order-by
- order-by-descending limit offset inner-join on)
+ order-by-descending limit offset inner-join on
+ all set-operation)
query
(when *in-subselect*
(write-string "(" *sql-stream*))
(write-string "SELECT " *sql-stream*)
- (when distinct
+ (when all
+ (write-string "ALL " *sql-stream*))
+ (when (and distinct (not all))
(write-string "DISTINCT " *sql-stream*)
(unless (eql t distinct)
(write-string "ON " *sql-stream*)
(if (listp order-by)
(do ((order order-by (cdr order)))
((null order))
- (output-sql (car order) database)
- (when (cdr order)
- (write-char #\, *sql-stream*)))
+ (let ((item (car order)))
+ (typecase item
+ (cons
+ (output-sql (car item) database)
+ (format *sql-stream* " ~A" (cadr item)))
+ (t
+ (output-sql item database)))
+ (when (cdr order)
+ (write-char #\, *sql-stream*))))
(output-sql order-by database)))
(when order-by-descending
(write-string " ORDER BY " *sql-stream*)
(write-string " OFFSET " *sql-stream*)
(output-sql offset database))
(when *in-subselect*
- (write-string ")" *sql-stream*)))
+ (write-string ")" *sql-stream*))
+ (when set-operation
+ (write-char #\Space *sql-stream*)
+ (output-sql set-operation database)))
t)
(defmethod output-sql ((query sql-object-query) database)
(apply #'make-query args))
(defsql sql-any (:symbol "any") (&rest rest)
- (make-instance 'sql-value-exp
- :modifier 'any :components rest))
+ (make-instance 'sql-function-exp
+ :name 'any :args rest))
(defsql sql-some (:symbol "some") (&rest rest)
- (make-instance 'sql-value-exp
- :modifier 'some :components rest))
+ (make-instance 'sql-function-exp
+ :name 'some :args rest))
(defsql sql-all (:symbol "all") (&rest rest)
- (make-instance 'sql-value-exp
- :modifier 'all :components rest))
+ (make-instance 'sql-function-exp
+ :name 'all :args rest))
(defsql sql-not (:symbol "not") (&rest rest)
(make-instance 'sql-value-exp
:operator 'except :sub-expressions rest))
(defsql sql-minus (:symbol "minus") (&rest rest)
- (make-instance 'sql-value-exp
- :modifier 'minus :components rest))
+ (make-instance 'sql-set-exp
+ :operator 'except :sub-expressions rest))
(defsql sql-limit (:symbol "limit") (&rest rest)
(make-instance 'sql-query-modifier-exp
:components '|NOT NULL|))
(defsql sql-exists (:symbol "exists") (&rest rest)
- (make-instance 'sql-value-exp
- :modifier 'exists :components rest))
+ (make-instance 'sql-function-exp
+ :name 'exists :args rest))
(defsql sql-* (:symbol "*") (&rest rest)
(if (zerop (length rest))
(defsql sql-in (:symbol "in") (&rest rest)
(make-instance 'sql-relational-exp
- :operator 'in :sub-expressions rest))
+ :operator 'in :sub-expressions rest))
(defsql sql-concat (:symbol "concat") (&rest rest)
(make-instance 'sql-relational-exp
(make-instance 'sql-query-modifier-exp :modifier 'distinct
:components rest))
+(defsql sql-coalesce (:symbol "coalesce") (&rest rest)
+ (make-instance 'sql-function-exp
+ :name 'coalesce :args rest))
+
+(defsql sql-nvl (:symbol "nvl") (&rest rest)
+ (make-instance 'sql-function-exp
+ :name 'coalesce :args rest))
(multiple-value-bind (result-set columns)
(database-query-result-set query-expression database :full-set nil
:result-types result-types)
- (when result-set
- (unwind-protect
- (do ((row (make-list columns)))
- ((not (database-store-next-row result-set database row))
- nil)
- (apply function row))
- (database-dump-result-set result-set database)))))
+ (let ((flatp (and (= columns 1)
+ (typecase query-expression
+ (string t)
+ (sql-query
+ (slot-value query-expression 'flatp))))))
+ (when result-set
+ (unwind-protect
+ (do ((row (make-list columns)))
+ ((not (database-store-next-row result-set database row))
+ nil)
+ (if flatp
+ (apply function row)
+ (funcall function row)))
+ (database-dump-result-set result-set database))))))
(defun map-query-to-list (function query-expression database result-types)
(multiple-value-bind (result-set columns)
(database-query-result-set query-expression database :full-set nil
:result-types result-types)
- (when result-set
- (unwind-protect
- (let ((result (list nil)))
- (do ((row (make-list columns))
- (current-cons result (cdr current-cons)))
- ((not (database-store-next-row result-set database row))
- (cdr result))
- (rplacd current-cons (list (apply function row)))))
- (database-dump-result-set result-set database)))))
-
+ (let ((flatp (and (= columns 1)
+ (typecase query-expression
+ (string t)
+ (sql-query
+ (slot-value query-expression 'flatp))))))
+ (when result-set
+ (unwind-protect
+ (let ((result (list nil)))
+ (do ((row (make-list columns))
+ (current-cons result (cdr current-cons)))
+ ((not (database-store-next-row result-set database row))
+ (cdr result))
+ (rplacd current-cons
+ (list (if flatp
+ (apply function row)
+ (funcall function (copy-list row)))))))
+ (database-dump-result-set result-set database))))))
(defun map-query-to-simple (output-type-spec function query-expression database result-types)
(multiple-value-bind (result-set columns rows)
(database-query-result-set query-expression database :full-set t
:result-types result-types)
- (when result-set
- (unwind-protect
- (if rows
- ;; We know the row count in advance, so we allocate once
- (do ((result
- (cmucl-compat:make-sequence-of-type output-type-spec rows))
- (row (make-list columns))
- (index 0 (1+ index)))
- ((not (database-store-next-row result-set database row))
- result)
- (declare (fixnum index))
- (setf (aref result index)
- (apply function row)))
- ;; Database can't report row count in advance, so we have
- ;; to grow and shrink our vector dynamically
- (do ((result
- (cmucl-compat:make-sequence-of-type output-type-spec 100))
- (allocated-length 100)
- (row (make-list columns))
- (index 0 (1+ index)))
- ((not (database-store-next-row result-set database row))
- (cmucl-compat:shrink-vector result index))
- (declare (fixnum allocated-length index))
- (when (>= index allocated-length)
- (setq allocated-length (* allocated-length 2)
- result (adjust-array result allocated-length)))
- (setf (aref result index)
- (apply function row))))
- (database-dump-result-set result-set database)))))
+ (let ((flatp (and (= columns 1)
+ (typecase query-expression
+ (string t)
+ (sql-query
+ (slot-value query-expression 'flatp))))))
+ (when result-set
+ (unwind-protect
+ (if rows
+ ;; We know the row count in advance, so we allocate once
+ (do ((result
+ (cmucl-compat:make-sequence-of-type output-type-spec rows))
+ (row (make-list columns))
+ (index 0 (1+ index)))
+ ((not (database-store-next-row result-set database row))
+ result)
+ (declare (fixnum index))
+ (setf (aref result index)
+ (if flatp
+ (apply function row)
+ (funcall function (copy-list row)))))
+ ;; Database can't report row count in advance, so we have
+ ;; to grow and shrink our vector dynamically
+ (do ((result
+ (cmucl-compat:make-sequence-of-type output-type-spec 100))
+ (allocated-length 100)
+ (row (make-list columns))
+ (index 0 (1+ index)))
+ ((not (database-store-next-row result-set database row))
+ (cmucl-compat:shrink-vector result index))
+ (declare (fixnum allocated-length index))
+ (when (>= index allocated-length)
+ (setq allocated-length (* allocated-length 2)
+ result (adjust-array result allocated-length)))
+ (setf (aref result index)
+ (if flatp
+ (apply function row)
+ (funcall function (copy-list row))))))
+ (database-dump-result-set result-set database))))))
;;; Row processing macro from CLSQL
(deftest :BASIC/MAP/1
(let ((results '())
- (rows (map-query 'vector #'list "select * from TYPE_TABLE"
+ (rows (map-query 'vector #'identity "select * from TYPE_TABLE"
:result-types nil)))
(declare (type (simple-array list (*)) rows))
(dotimes (i (length rows) results)
(deftest :BASIC/MAP/2
(let ((results '())
- (rows (map-query 'list #'list "select * from TYPE_TABLE"
+ (rows (map-query 'list #'identity "select * from TYPE_TABLE"
:result-types nil)))
(dotimes (i (length rows) results)
(push
(deftest :BASIC/MAP/3
(let ((results '())
- (rows (map-query 'list #'list "select * from TYPE_TABLE"
+ (rows (map-query 'list #'identity "select * from TYPE_TABLE"
:result-types :auto)))
(dotimes (i (length rows) results)
(push
:order-by '(["table" last-name])
:result-types nil :field-names nil)
(("Vladamir" "Lenin") ("Vladamir" "Putin")))
+
+(deftest :fdml/select/27
+ (clsql:select [coalesce [managerid] 10] :from [employee] :order-by [emplid]
+ :field-names nil :result-types nil :flatp t)
+ ("10" "1" "1" "1" "1" "1" "1" "1" "1" "1"))
;(deftest :fdml/select/11
; (clsql:select [emplid] :from [employee]
(deftest :syntax/subquery/1
(clsql:sql [any '(3 4)])
- "(ANY ((3,4)))")
+ "ANY((3,4))")
(deftest :syntax/subquery/2
(clsql:sql [in [foo] '(foo bar baz)])
(deftest :syntax/subquery/3
(clsql:sql [all '(foo bar baz)])
- "(ALL ((FOO,BAR,BAZ)))")
+ "ALL((FOO,BAR,BAZ))")
(deftest :syntax/subquery/4
(clsql:sql [exists '(foo bar baz)])
- "(EXISTS ((FOO,BAR,BAZ)))")
+ "EXISTS((FOO,BAR,BAZ))")
(deftest :syntax/subquery/5
(clsql:sql [some '(foo bar baz)])
- "(SOME ((FOO,BAR,BAZ)))")
+ "SOME((FOO,BAR,BAZ))")
(deftest :syntax/aggregate/1
"GROUP BY FOO")
+(deftest :syntax/coalesce/1
+ (clsql:sql [coalesce [foo] [bar] "not specified"])
+ "COALESCE(FOO,BAR,'not specified')")
+
+(deftest :syntax/coalesce/2
+ (clsql:sql [nvl [foo] "not specified"])
+ "COALESCE(FOO,'not specified')")
+
+
(deftest :syntax/sets/1
(clsql:sql [union [select [foo] :from [bar]] [select [baz] :from [bar]]])
"SELECT FOO FROM BAR UNION SELECT BAZ FROM BAR")
(clsql:sql [except [select [foo] :from [bar]] [select [baz] :from [bar]]])
"SELECT FOO FROM BAR EXCEPT SELECT BAZ FROM BAR")
+(deftest :syntax/sets/4
+ (clsql:sql [minus [select [foo] :from [bar]] [select [baz] :from [bar]]])
+ "SELECT FOO FROM BAR EXCEPT SELECT BAZ FROM BAR")
+
(deftest :syntax/function/1
(clsql:sql [function "COS" [age]])
projects / clsql.git / commitdiff