(error "Unable to update records"))))
(values))
-(defmethod update-records-from-instance ((obj standard-db-object)
- &key (database *default-database*))
- (let ((database (or (view-database obj) database)))
+(defmethod update-records-from-instance ((obj standard-db-object) &key database)
+ (let ((database (or database (view-database obj) *default-database*)))
(labels ((slot-storedp (slot)
(and (member (view-class-slot-db-kind slot) '(:base :key))
(slot-boundp obj (slot-definition-name slot))))
(if vd
(let ((qualifier (key-qualifier-for-instance instance :database vd)))
(delete-records :from vt :where qualifier :database vd)
+ (setf (record-caches vd) nil)
(setf (slot-value instance 'view-database) nil)
(values))
(signal-no-database-error vd))))
(sels (generate-selection-list view-class))
(res (apply #'select (append (mapcar #'cdr sels)
(list :from view-table
- :where view-qual)
- (list :result-types nil)))))
+ :where view-qual
+ :result-types nil
+ :database vd)))))
(when res
(get-slot-values-from-view instance (mapcar #'car sels) (car res)))))
"INT")
(deftype smallint ()
- "An integer smaller than a 32-bit integer, this width may vary by SQL implementation."
+ "An integer smaller than a 32-bit integer. this width may vary by SQL implementation."
'integer)
(defmethod database-get-type-specifier ((type (eql 'smallint)) args database db-type)
(declare (ignore args database db-type))
"INT")
+(deftype mediumint ()
+ "An integer smaller than a 32-bit integer, but may be larger than a smallint. This width may vary by SQL implementation."
+ 'integer)
+
+(defmethod database-get-type-specifier ((type (eql 'mediumint)) args database db-type)
+ (declare (ignore args database db-type))
+ "INT")
+
(deftype bigint ()
"An integer larger than a 32-bit integer, this width may vary by SQL implementation."
'integer)
:attribute (gethash :home-key tdbi)
:table jc-view-table))
:where jq
- :result-types :auto)))
+ :result-types :auto
+ :database (view-database object))))
(mapcar #'(lambda (i)
(let* ((instance (car i))
(jcc (make-instance jc :view-database (view-database instance))))
(list instance jcc)))
(select (sql-expression :attribute (gethash :foreign-key tdbi) :table jc-view-table)
:from (sql-expression :table jc-view-table)
- :where jq)))))))
+ :where jq
+ :database (view-database object))))))))
;;; Remote Joins
keys))
:result-types :auto
:flatp t)))
+
(dolist (object objects)
(when (or force-p (not (slot-boundp object slotdef-name)))
- (let ((res (find (slot-value object home-key) results
- :key #'(lambda (res) (slot-value res foreign-key))
- :test #'equal)))
+ (let ((res (remove-if-not #'(lambda (obj)
+ (equal obj (slot-value
+ object
+ home-key)))
+ results
+ :key #'(lambda (res)
+ (slot-value res
+ foreign-key)))))
(when res
- (setf (slot-value object slotdef-name) res)))))))))))
+ (setf (slot-value object slotdef-name)
+ (if (gethash :set dbi) res (car res)))))))))))))
(values))
-
+
(defun fault-join-slot-raw (class object slot-def)
(let* ((dbi (view-class-slot-db-info slot-def))
(jc (gethash :join-class dbi)))
(let ((jq (join-qualifier class object slot-def)))
(when jq
- (select jc :where jq :flatp t :result-types nil)))))
+ (select jc :where jq :flatp t :result-types nil
+ :database (view-database object))))))
(defun fault-join-slot (class object slot-def)
(let* ((dbi (view-class-slot-db-info slot-def))
(unless (record-caches database)
(setf (record-caches database)
(make-hash-table :test 'equal
- #+allegro :values #+allegro :weak
+ #+allegro :values #+allegro :weak
+ #+clisp :weak #+clisp :value
#+lispworks :weak-kind #+lispworks :value)))
(setf (gethash (compute-records-cache-key targets qualifiers)
(record-caches database)) results)