(defun create-view-from-class (view-class-name
&key (database *default-database*))
- "Creates a view in DATABASE based on VIEW-CLASS-NAME which defines
-the view. The argument DATABASE has a default value of
-*DEFAULT-DATABASE*."
+ "Creates a table as defined by the View Class VIEW-CLASS-NAME
+in DATABASE which defaults to *DEFAULT-DATABASE*."
(let ((tclass (find-class view-class-name)))
(if tclass
(let ((*default-database* database))
(push res schemadef))))
(unless schemadef
(error "Class ~s has no :base slots" self))
- (create-table (sql-expression :table (view-table self)) schemadef
+ (create-table (sql-expression :table (view-table self)) (nreverse schemadef)
:database database
:constraints (database-pkey-constraint self database))
(push self (database-view-classes database))
;;
(defun drop-view-from-class (view-class-name &key (database *default-database*))
- "Deletes a view or base table from DATABASE based on VIEW-CLASS-NAME
-which defines that view. The argument DATABASE has a default value of
-*DEFAULT-DATABASE*."
+ "Removes a table defined by the View Class VIEW-CLASS-NAME from
+DATABASE which defaults to *DEFAULT-DATABASE*."
(let ((tclass (find-class view-class-name)))
(if tclass
(let ((*default-database* database))
(defun list-classes (&key (test #'identity)
(root-class (find-class 'standard-db-object))
(database *default-database*))
- "The LIST-CLASSES function collects all the classes below
-ROOT-CLASS, which defaults to standard-db-object, that are connected
-to the supplied DATABASE and which satisfy the TEST function. The
-default for the TEST argument is identity. By default, LIST-CLASSES
-returns a list of all the classes connected to the default database,
-*DEFAULT-DATABASE*."
+ "Returns a list of all the View Classes which are connected to
+DATABASE, which defaults to *DEFAULT-DATABASE*, and which descend
+from the class ROOT-CLASS and which satisfy the function TEST. By
+default ROOT-CLASS is STANDARD-DB-OBJECT and TEST is IDENTITY."
(flet ((find-superclass (class)
(member root-class (class-precedence-list class))))
(let ((view-classes (and database (database-view-classes database))))
;;
(defmacro def-view-class (class supers slots &rest cl-options)
- "Extends the syntax of defclass to allow special slots to be mapped
-onto the attributes of database views. The macro DEF-VIEW-CLASS
-creates a class called CLASS which maps onto a database view. Such a
-class is called a View Class. The macro DEF-VIEW-CLASS extends the
-syntax of DEFCLASS to allow special base slots to be mapped onto the
-attributes of database views (presently single tables). When a select
-query that names a View Class is submitted, then the corresponding
-database view is queried, and the slots in the resulting View Class
-instances are filled with attribute values from the database. If
-SUPERS is nil then STANDARD-DB-OBJECT automatically becomes the
-superclass of the newly-defined View Class."
+ "Creates a View Class called CLASS whose slots SLOTS can map
+onto the attributes of a table in a database. If SUPERS is nil
+then the superclass of CLASS will be STANDARD-DB-OBJECT,
+otherwise SUPERS is a list of superclasses for CLASS which must
+include STANDARD-DB-OBJECT or a descendent of this class. The
+syntax of DEFCLASS is extended through the addition of a class
+option :base-table which defines the database table onto which
+the View Class maps and which defaults to CLASS. The DEFCLASS
+syntax is also extended through additional slot
+options. The :db-kind slot option specifies the kind of DB
+mapping which is performed for this slot and defaults to :base
+which indicates that the slot maps to an ordinary column of the
+database table. A :db-kind value of :key indicates that this slot
+is a special kind of :base slot which maps onto a column which is
+one of the unique keys for the database table, the value :join
+indicates this slot represents a join onto another View Class
+which contains View Class objects, and the value :virtual
+indicates a standard CLOS slot which does not map onto columns of
+the database table. If a slot is specified with :db-kind :join,
+the slot option :db-info contains a list which specifies the
+nature of the join. For slots of :db-kind :base or :key,
+the :type slot option has a special interpretation such that Lisp
+types, such as string, integer and float are automatically
+converted into appropriate SQL types for the column onto which
+the slot maps. This behaviour may be over-ridden using
+the :db-type slot option which is a string specifying the
+vendor-specific database type for this slot's column definition
+in the database. The :column slot option specifies the name of
+the SQL column which the slot maps onto, if :db-kind is
+not :virtual, and defaults to the slot name. The :void-value slot
+option specifies the value to store if the SQL value is NULL and
+defaults to NIL. The :db-constraints slot option is a string
+representing an SQL table constraint expression or a list of such
+strings."
`(progn
(defclass ,class ,supers ,slots
,@(if (find :metaclass `,cl-options :key #'car)
(cond ((and value (null slot-reader))
(setf (slot-value instance slot-name)
(read-sql-value value (delistify slot-type)
- (view-database instance))))
- ((null value)
+ (view-database instance)
+ (database-underlying-type
+ (view-database instance)))))
+ ((null value)
(update-slot-with-null instance slot-name slotdef))
((typep slot-reader 'string)
(setf (slot-value instance slot-name)
(let ((slot-reader (view-class-slot-db-reader slotdef))
(slot-type (specified-type slotdef)))
(cond ((and value (null slot-reader))
- (read-sql-value value (delistify slot-type) database))
+ (read-sql-value value (delistify slot-type) database
+ (database-underlying-type database)))
((null value)
nil)
((typep slot-reader 'string)
(string (format nil dbwriter val))
(function (apply dbwriter (list val)))
(t
- (typecase dbtype
- (cons
- (database-output-sql-as-type (car dbtype) val database))
- (t
- (database-output-sql-as-type dbtype val database)))))))
+ (database-output-sql-as-type
+ (typecase dbtype
+ (cons (car dbtype))
+ (t dbtype))
+ val database (database-underlying-type database))))))
(defun check-slot-type (slotdef val)
(let* ((slot-type (specified-type slotdef))
(error "No view-table for class ~A" classname))
(sql-expression :table (view-table class))))
-(defmethod database-get-type-specifier (type args database)
- (declare (ignore type args))
- (if (in (database-underlying-type database)
- :postgresql :postgresql-socket)
- "VARCHAR"
- "VARCHAR(255)"))
+(defmethod database-get-type-specifier (type args database db-type)
+ (declare (ignore type args database db-type))
+ "VARCHAR(255)")
-(defmethod database-get-type-specifier ((type (eql 'integer)) args database)
- (declare (ignore database))
- ;;"INT8")
+(defmethod database-get-type-specifier ((type (eql 'integer)) args database db-type)
+ (declare (ignore database db-type))
(if args
(format nil "INT(~A)" (car args))
"INT"))
"An integer larger than a 32-bit integer, this width may vary by SQL implementation."
'integer)
-(defmethod database-get-type-specifier ((type (eql 'bigint)) args database)
- (declare (ignore args database))
+(defmethod database-get-type-specifier ((type (eql 'bigint)) args database db-type)
+ (declare (ignore args database db-type))
"BIGINT")
(defmethod database-get-type-specifier ((type (eql 'simple-base-string)) args
- database)
+ database db-type)
+ (declare (ignore database db-type))
(if args
(format nil "VARCHAR(~A)" (car args))
- (if (in (database-underlying-type database)
- :postgresql :postgresql-socket)
- "VARCHAR"
- "VARCHAR(255)")))
+ "VARCHAR(255)"))
(defmethod database-get-type-specifier ((type (eql 'simple-string)) args
- database)
+ database db-type)
+ (declare (ignore database db-type))
(if args
(format nil "VARCHAR(~A)" (car args))
- (if (in (database-underlying-type database)
- :postgresql :postgresql-socket)
- "VARCHAR"
- "VARCHAR(255)")))
+ "VARCHAR(255)"))
-(defmethod database-get-type-specifier ((type (eql 'string)) args database)
+(defmethod database-get-type-specifier ((type (eql 'string)) args database db-type)
+ (declare (ignore database db-type))
(if args
(format nil "VARCHAR(~A)" (car args))
- (if (in (database-underlying-type database)
- :postgresql :postgresql-socket)
- "VARCHAR"
- "VARCHAR(255)")))
+ "VARCHAR(255)"))
(deftype universal-time ()
"A positive integer as returned by GET-UNIVERSAL-TIME."
'(integer 1 *))
-(defmethod database-get-type-specifier ((type (eql 'universal-time)) args database)
- (declare (ignore args database))
+(defmethod database-get-type-specifier ((type (eql 'universal-time)) args database db-type)
+ (declare (ignore args database db-type))
"BIGINT")
-(defmethod database-get-type-specifier ((type (eql 'wall-time)) args database)
- (declare (ignore args))
- (case (database-underlying-type database)
- ((:postgresql :postgresql-socket)
- "TIMESTAMP WITHOUT TIME ZONE")
- (:mysql
- "DATETIME")
- (t "TIMESTAMP")))
-
-(defmethod database-get-type-specifier ((type (eql 'duration)) args database)
- (declare (ignore database args))
+(defmethod database-get-type-specifier ((type (eql 'wall-time)) args database db-type)
+ (declare (ignore args database db-type))
+ "TIMESTAMP")
+
+(defmethod database-get-type-specifier ((type (eql 'duration)) args database db-type)
+ (declare (ignore database args db-type))
"VARCHAR")
-(defmethod database-get-type-specifier ((type (eql 'money)) args database)
- (declare (ignore database args))
+(defmethod database-get-type-specifier ((type (eql 'money)) args database db-type)
+ (declare (ignore database args db-type))
"INT8")
(deftype raw-string (&optional len)
"A string which is not trimmed when retrieved from the database"
`(string ,len))
-(defmethod database-get-type-specifier ((type (eql 'raw-string)) args database)
- (declare (ignore database))
+(defmethod database-get-type-specifier ((type (eql 'raw-string)) args database db-type)
+ (declare (ignore database db-type))
(if args
(format nil "VARCHAR(~A)" (car args))
"VARCHAR"))
-(defmethod database-get-type-specifier ((type (eql 'float)) args database)
- (declare (ignore database))
+(defmethod database-get-type-specifier ((type (eql 'float)) args database db-type)
+ (declare (ignore database db-type))
(if args
(format nil "FLOAT(~A)" (car args))
"FLOAT"))
-(defmethod database-get-type-specifier ((type (eql 'long-float)) args database)
- (declare (ignore database))
+(defmethod database-get-type-specifier ((type (eql 'long-float)) args database db-type)
+ (declare (ignore database db-type))
(if args
(format nil "FLOAT(~A)" (car args))
"FLOAT"))
-(defmethod database-get-type-specifier ((type (eql 'boolean)) args database)
- (declare (ignore args database))
+(defmethod database-get-type-specifier ((type (eql 'boolean)) args database db-type)
+ (declare (ignore args database db-type))
"BOOL")
-(defmethod database-output-sql-as-type (type val database)
- (declare (ignore type database))
+(defmethod database-output-sql-as-type (type val database db-type)
+ (declare (ignore type database db-type))
val)
-(defmethod database-output-sql-as-type ((type (eql 'list)) val database)
- (declare (ignore database))
+(defmethod database-output-sql-as-type ((type (eql 'list)) val database db-type)
+ (declare (ignore database db-type))
(progv '(*print-circle* *print-array*) '(t t)
(let ((escaped (prin1-to-string val)))
(substitute-char-string
escaped #\Null " "))))
-(defmethod database-output-sql-as-type ((type (eql 'symbol)) val database)
- (declare (ignore database))
+(defmethod database-output-sql-as-type ((type (eql 'symbol)) val database db-type)
+ (declare (ignore database db-type))
(if (keywordp val)
(symbol-name val)
(if val
(symbol-name val))
"")))
-(defmethod database-output-sql-as-type ((type (eql 'keyword)) val database)
- (declare (ignore database))
+(defmethod database-output-sql-as-type ((type (eql 'keyword)) val database db-type)
+ (declare (ignore database db-type))
(if val
(symbol-name val)
""))
-(defmethod database-output-sql-as-type ((type (eql 'vector)) val database)
- (declare (ignore database))
+(defmethod database-output-sql-as-type ((type (eql 'vector)) val database db-type)
+ (declare (ignore database db-type))
(progv '(*print-circle* *print-array*) '(t t)
(prin1-to-string val)))
-(defmethod database-output-sql-as-type ((type (eql 'array)) val database)
- (declare (ignore database))
+(defmethod database-output-sql-as-type ((type (eql 'array)) val database db-type)
+ (declare (ignore database db-type))
(progv '(*print-circle* *print-array*) '(t t)
(prin1-to-string val)))
-(defmethod database-output-sql-as-type ((type (eql 'boolean)) val database)
- (case (database-underlying-type database)
- (:mysql
- (if val 1 0))
- (t
- (if val "t" "f"))))
+(defmethod database-output-sql-as-type ((type (eql 'boolean)) val database db-type)
+ (declare (ignore database db-type))
+ (if val "t" "f"))
-(defmethod database-output-sql-as-type ((type (eql 'string)) val database)
- (declare (ignore database))
+(defmethod database-output-sql-as-type ((type (eql 'string)) val database db-type)
+ (declare (ignore database db-type))
val)
(defmethod database-output-sql-as-type ((type (eql 'simple-string))
- val database)
- (declare (ignore database))
+ val database db-type)
+ (declare (ignore database db-type))
val)
(defmethod database-output-sql-as-type ((type (eql 'simple-base-string))
- val database)
- (declare (ignore database))
+ val database db-type)
+ (declare (ignore database db-type))
val)
-(defmethod read-sql-value (val type database)
- (declare (ignore type database))
+(defmethod read-sql-value (val type database db-type)
+ (declare (ignore type database db-type))
(read-from-string val))
-(defmethod read-sql-value (val (type (eql 'string)) database)
- (declare (ignore database))
+(defmethod read-sql-value (val (type (eql 'string)) database db-type)
+ (declare (ignore database db-type))
val)
-(defmethod read-sql-value (val (type (eql 'simple-string)) database)
- (declare (ignore database))
+(defmethod read-sql-value (val (type (eql 'simple-string)) database db-type)
+ (declare (ignore database db-type))
val)
-(defmethod read-sql-value (val (type (eql 'simple-base-string)) database)
- (declare (ignore database))
+(defmethod read-sql-value (val (type (eql 'simple-base-string)) database db-type)
+ (declare (ignore database db-type))
val)
-(defmethod read-sql-value (val (type (eql 'raw-string)) database)
- (declare (ignore database))
+(defmethod read-sql-value (val (type (eql 'raw-string)) database db-type)
+ (declare (ignore database db-type))
val)
-(defmethod read-sql-value (val (type (eql 'keyword)) database)
- (declare (ignore database))
+(defmethod read-sql-value (val (type (eql 'keyword)) database db-type)
+ (declare (ignore database db-type))
(when (< 0 (length val))
(intern (symbol-name-default-case val)
(find-package '#:keyword))))
-(defmethod read-sql-value (val (type (eql 'symbol)) database)
- (declare (ignore database))
+(defmethod read-sql-value (val (type (eql 'symbol)) database db-type)
+ (declare (ignore database db-type))
(when (< 0 (length val))
(unless (string= val (symbol-name-default-case "NIL"))
(intern (symbol-name-default-case val)
(symbol-package *update-context*)))))
-(defmethod read-sql-value (val (type (eql 'integer)) database)
- (declare (ignore database))
+(defmethod read-sql-value (val (type (eql 'integer)) database db-type)
+ (declare (ignore database db-type))
(etypecase val
(string
(unless (string-equal "NIL" val)
(parse-integer val)))
(number val)))
-(defmethod read-sql-value (val (type (eql 'bigint)) database)
- (declare (ignore database))
+(defmethod read-sql-value (val (type (eql 'bigint)) database db-type)
+ (declare (ignore database db-type))
(etypecase val
(string
(unless (string-equal "NIL" val)
(parse-integer val)))
(number val)))
-(defmethod read-sql-value (val (type (eql 'float)) database)
- (declare (ignore database))
+(defmethod read-sql-value (val (type (eql 'float)) database db-type)
+ (declare (ignore database db-type))
;; writing 1.0 writes 1, so we we *really* want a float, must do (float ...)
- (float (read-from-string val)))
-
-(defmethod read-sql-value (val (type (eql 'boolean)) database)
- (case (database-underlying-type database)
- (:mysql
- (etypecase val
- (string (if (string= "0" val) nil t))
- (integer (if (zerop val) nil t))))
- (:postgresql
- (if (eq :odbc (database-type database))
- (if (string= "0" val) nil t)
- (equal "t" val)))
- (t
- (equal "t" val))))
-
-(defmethod read-sql-value (val (type (eql 'univeral-time)) database)
- (declare (ignore database))
+ (etypecase val
+ (string
+ (float (read-from-string val)))
+ (float
+ val)))
+
+(defmethod read-sql-value (val (type (eql 'boolean)) database db-type)
+ (declare (ignore database db-type))
+ (equal "t" val))
+
+(defmethod read-sql-value (val (type (eql 'univeral-time)) database db-type)
+ (declare (ignore database db-type))
(unless (eq 'NULL val)
(etypecase val
(string
(parse-integer val))
(number val))))
-(defmethod read-sql-value (val (type (eql 'wall-time)) database)
- (declare (ignore database))
+(defmethod read-sql-value (val (type (eql 'wall-time)) database db-type)
+ (declare (ignore database db-type))
(unless (eq 'NULL val)
(parse-timestring val)))
-(defmethod read-sql-value (val (type (eql 'duration)) database)
- (declare (ignore database))
+(defmethod read-sql-value (val (type (eql 'duration)) database db-type)
+ (declare (ignore database db-type))
(unless (or (eq 'NULL val)
(equal "NIL" val))
(parse-timestring val)))
:from (sql-expression :table jc-view-table)
:where jq)))))))
-(defun update-object-joins (objects &key (slots t) (force-p t)
- class-name (max-len *default-update-objects-max-len*))
- "Updates the remote join slots, that is those slots defined without
-:retrieval :immediate."
+
+;;; Remote Joins
+
+(defvar *default-update-objects-max-len* nil
+ "The default value to use for the MAX-LEN keyword argument to
+ UPDATE-OBJECT-JOINS.")
+
+(defun update-objects-joins (objects &key (slots t) (force-p t)
+ class-name (max-len
+ *default-update-objects-max-len*))
+ "Updates from the records of the appropriate database tables
+the join slots specified by SLOTS in the supplied list of View
+Class instances OBJECTS. SLOTS is t by default which means that
+all join slots with :retrieval :immediate are updated. CLASS-NAME
+is used to specify the View Class of all instance in OBJECTS and
+default to nil which means that the class of the first instance
+in OBJECTS is used. FORCE-P is t by default which means that all
+join slots are updated whereas a value of nil means that only
+unbound join slots are updated. MAX-LEN defaults to
+*DEFAULT-UPDATE-OBJECTS-MAX-LEN* and when non-nil specifies that
+UPDATE-OBJECT-JOINS may issue multiple database queries with a
+maximum of MAX-LEN instances updated in each query."
(assert (or (null max-len) (plusp max-len)))
(when objects
(unless class-name
:operator 'in
:sub-expressions (list (sql-expression :attribute foreign-key)
keys))
+ :result-types :auto
:flatp t)))
(dolist (object objects)
(when (or force-p (not (slot-boundp object slotdef-name)))
jcs))
immediate-join-classes)
sel-tables)
- :test #'tables-equal))))
- (dolist (ob (listify order-by))
+ :test #'tables-equal)))
+ (order-by-slots (mapcar #'(lambda (ob) (if (atom ob) ob (car ob)))
+ (listify order-by))))
+
+ (dolist (ob order-by-slots)
(when (and ob (not (member ob (mapcar #'cdr fullsels)
:test #'ref-equal)))
(setq fullsels
- (append fullsels (mapcar #'(lambda (att) (cons nil att))
- (listify ob))))))
+ (append fullsels (mapcar #'(lambda (att) (cons nil att))
+ order-by-slots)))))
(dolist (ob (listify distinct))
(when (and (typep ob 'sql-ident)
(not (member ob (mapcar #'cdr fullsels)
(defmethod instance-refreshed ((instance standard-db-object)))
(defun select (&rest select-all-args)
- "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."
+ "Executes a query on DATABASE, which has a default value of
+*DEFAULT-DATABASE*, specified by the SQL expressions supplied
+using the remaining arguments in SELECT-ALL-ARGS. The SELECT
+argument can be used to generate queries in both functional and
+object oriented contexts.
+
+In the functional case, the required arguments specify the
+columns selected by the query and may be symbolic SQL expressions
+or strings representing attribute identifiers. Type modified
+identifiers indicate that the values selected from the specified
+column are converted to the specified lisp type. The keyword
+arguments ALL, DISTINCT, FROM, GROUP-by, HAVING, ORDER-BY,
+SET-OPERATION and WHERE are used to specify, using the symbolic
+SQL syntax, the corresponding components of the SQL query
+generated by the call to SELECT. RESULT-TYPES is a list of
+symbols which specifies the lisp type for each field returned by
+the query. If RESULT-TYPES is nil all results are returned as
+strings whereas the default value of :auto means that the lisp
+types are automatically computed for each field. FIELD-NAMES is t
+by default which means that the second value returned is a list
+of strings representing the columns selected by the query. If
+FIELD-NAMES is nil, the list of column names is not returned as a
+second value.
+
+In the object oriented case, the required arguments to SELECT are
+symbols denoting View Classes which specify the database tables
+to query. In this case, SELECT returns a list of View Class
+instances whose slots are set from the attribute values of the
+records in the specified table. Slot-value is a legal operator
+which can be employed as part of the symbolic SQL syntax used in
+the WHERE keyword argument to SELECT. REFRESH is nil by default
+which means that the View Class instances returned are retrieved
+from a cache if an equivalent call to SELECT has previously been
+issued. If REFRESH is true, the View Class instances returned are
+updated as necessary from the database and the generic function
+INSTANCE-REFRESHED is called to perform any necessary operations
+on the updated instances.
+
+In both object oriented and functional contexts, FLATP has a
+default value of nil which means that the results are returned as
+a list of lists. If FLATP is t and only one result is returned
+for each record selected in the query, the results are returned
+as elements of a list."
(flet ((select-objects (target-args)
(and target-args
target-args))))
(multiple-value-bind (target-args qualifier-args)
(query-get-selections select-all-args)
+ (unless (or *default-database* (getf qualifier-args :database))
+ (signal-no-database-error nil))
+
(cond
((select-objects target-args)
(let ((caching (getf qualifier-args :caching t))
+ (result-types (getf qualifier-args :result-types :auto))
(refresh (getf qualifier-args :refresh nil))
- (database (or (getf qualifier-args :database) *default-database*)))
+ (database (or (getf qualifier-args :database) *default-database*))
+ (order-by (getf qualifier-args :order-by)))
(remf qualifier-args :caching)
(remf qualifier-args :refresh)
+ (remf qualifier-args :result-types)
+
+
+ ;; Add explicity table name to order-by if not specified and only
+ ;; one selected table. This is required so FIND-ALL won't duplicate
+ ;; the field
+ (when (and order-by (= 1 (length target-args)))
+ (let ((table-name (view-table (find-class (car target-args))))
+ (order-by-list (copy-seq (listify order-by))))
+
+ (loop for i from 0 below (length order-by-list)
+ do (etypecase (nth i order-by-list)
+ (sql-ident-attribute
+ (unless (slot-value (nth i order-by-list) 'qualifier)
+ (setf (slot-value (nth i order-by-list) 'qualifier) table-name)))
+ (cons
+ (unless (slot-value (car (nth i order-by-list)) 'qualifier)
+ (setf (slot-value (car (nth i order-by-list)) 'qualifier) table-name)))))
+ (setf (getf qualifier-args :order-by) order-by-list)))
+
(cond
((null caching)
- (apply #'find-all target-args qualifier-args))
+ (apply #'find-all target-args
+ (append qualifier-args (list :result-types result-types))))
(t
(let ((cached (records-cache-results target-args qualifier-args database)))
(cond
((and cached (not refresh))
cached)
((and cached refresh)
- (let ((results (apply #'find-all (append (list target-args) qualifier-args `(:instances ,cached)))))
+ (let ((results (apply #'find-all (append (list target-args) qualifier-args `(:instances ,cached :result-types :auto)))))
(setf (records-cache-results target-args qualifier-args database) results)
results))
(t
- (let ((results (apply #'find-all target-args qualifier-args)))
+ (let ((results (apply #'find-all target-args (append qualifier-args
+ '(:result-types :auto)))))
(setf (records-cache-results target-args qualifier-args database) results)
results))))))))
(t
(when value
(push (list arg
(typecase value
+ (cons (cons (sql (car value)) (cdr value)))
(%sql-expression (sql value))
(t value)))
results))))))
projects / clsql.git / blobdiff