(basetype (if (listp slot-type) (car slot-type) slot-type)))
(when (and slot-type val)
(unless (typep val basetype)
- (error 'clsql-type-error
- :slotname (slot-definition-name slotdef)
- :typespec slot-type
- :value val)))))
+ (error 'sql-user-error
+ :message
+ (format nil "Invalid value ~A in slot ~A, not of type ~A."
+ val (slot-definition-name slotdef) slot-type))))))
;;
;; Called by find-all
(let ((qualifier (key-qualifier-for-instance instance :database vd)))
(delete-records :from vt :where qualifier :database vd)
(setf (slot-value instance 'view-database) nil))
- (error 'clsql-no-database-error :database nil))))
+ (signal-no-database-error vd))))
(defmethod update-instance-from-records ((instance standard-db-object)
&key (database *default-database*))
(defmethod read-sql-value (val (type (eql 'float)) database)
(declare (ignore database))
;; writing 1.0 writes 1, so we we *really* want a float, must do (float ...)
- (float (read-from-string val)))
+ (etypecase val
+ (string
+ (float (read-from-string val)))
+ (float
+ val)))
(defmethod read-sql-value (val (type (eql 'boolean)) database)
(case (database-underlying-type database)
:from (sql-expression :table jc-view-table)
:where jq)))))))
+
+;;; Remote Joins
+
+(defvar *default-update-objects-max-len* nil
+ "The default maximum number of objects supplying data for a
+ query when updating remote joins.")
+
(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
: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)
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