(car objects)
objects))))
+(defmethod select-table-sql-expr ((table T))
+ "Turns an object representing a table into the :from part of the sql expression that will be executed "
+ (sql-expression :table (view-table table)))
+
(defun find-all (view-classes
&rest args
&key all set-operation distinct from where group-by having
order-by offset limit refresh flatp result-types
inner-join on
(database *default-database*)
- instances)
+ instances parameters)
"Called by SELECT to generate object query results when the
View Classes VIEW-CLASSES are passed as arguments to SELECT."
(declare (ignore all set-operation group-by having offset limit inner-join on))
(flet ((ref-equal (ref1 ref2)
(string= (sql-output ref1 database)
(sql-output ref2 database)))
- (table-sql-expr (table)
- (sql-expression :table (view-table table)))
(tables-equal (table-a table-b)
(when (and table-a table-b)
(string= (string (slot-value table-a 'name))
(fullsels (apply #'append (mapcar #'append sels immediate-join-sels)))
(sel-tables (collect-table-refs where))
(tables (remove-if #'null
- (remove-duplicates
- (append (mapcar #'table-sql-expr sclasses)
- (mapcan #'(lambda (jc-list)
- (mapcar
- #'(lambda (jc) (when jc (table-sql-expr jc)))
- jc-list))
- immediate-join-classes)
- sel-tables)
- :test #'tables-equal)))
+ (remove-duplicates
+ (append (mapcar #'select-table-sql-expr sclasses)
+ (mapcan #'(lambda (jc-list)
+ (mapcar
+ #'(lambda (jc) (when jc (select-table-sql-expr jc)))
+ jc-list))
+ immediate-join-classes)
+ sel-tables)
+ :test #'tables-equal)))
(order-by-slots (mapcar #'(lambda (ob) (if (atom ob) ob (car ob)))
(listify order-by)))
(join-where nil))
results))))))))
(t
(let* ((expr (apply #'make-query select-all-args))
+ (parameters (second (member :parameters select-all-args)))
(specified-types
(mapcar #'(lambda (attrib)
(if (typep attrib 'sql-ident-attribute)
t))
t))
(slot-value expr 'selections))))
+
(destructuring-bind (&key (flatp nil)
- (result-types :auto)
- (field-names t)
- (database *default-database*)
- &allow-other-keys)
+ (result-types :auto)
+ (field-names t)
+ (database *default-database*)
+ &allow-other-keys)
qualifier-args
+ (when parameters
+ (setf expr (make-instance 'command-object
+ :expression (sql-output expr database)
+ :parameters parameters)))
(query expr :flatp flatp
:result-types
;; specifying a type for an attribute overrides result-types