From: Kevin M. Rosenberg Date: Mon, 31 Oct 2005 04:20:59 +0000 (+0000) Subject: r10794: 30 Oct 2005 Kevin Rosenberg X-Git-Tag: v3.8.6~112 X-Git-Url: http://git.kpe.io/?p=clsql.git;a=commitdiff_plain;h=cae6d8a460e682e53c50981a5cf5e19240a6b7a8 r10794: 30 Oct 2005 Kevin Rosenberg * Version 3.3.3 * sql/oodml.lisp: Apply patch from Drew Crampsie to fix update-objects-joins when using the :target-slot attribute --- diff --git a/ChangeLog b/ChangeLog index 2cd38be..cf2e75c 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +30 Oct 2005 Kevin Rosenberg + * Version 3.3.3 + * sql/oodml.lisp: Apply patch from Drew Crampsie to fix + update-objects-joins when using the :target-slot attribute + 26 Oct 2005 Kevin Rosenberg * Version 3.3.2 * sql/expressions.lisp: Avoid parenthesis on multiple group-by fields diff --git a/debian/changelog b/debian/changelog index 5a19448..ededa47 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,9 @@ +cl-sql (3.3.3-1) unstable; urgency=low + + * New upstream + + -- Kevin M. Rosenberg Sun, 30 Oct 2005 21:20:34 -0700 + cl-sql (3.3.2-1) unstable; urgency=low * New upstream diff --git a/sql/oodml.lisp b/sql/oodml.lisp index 187694d..58622ae 100644 --- a/sql/oodml.lisp +++ b/sql/oodml.lisp @@ -627,21 +627,23 @@ (defun fault-join-target-slot (class object slot-def) (let* ((dbi (view-class-slot-db-info slot-def)) - (ts (gethash :target-slot dbi)) - (jc (gethash :join-class dbi)) - (ts-view-table (view-table (find-class ts))) + (ts (gethash :target-slot dbi)) + (jc (gethash :join-class dbi)) (jc-view-table (view-table (find-class jc))) - (tdbi (view-class-slot-db-info - (find ts (class-slots (find-class jc)) - :key #'slot-definition-name))) + (tdbi (view-class-slot-db-info + (find ts (class-slots (find-class jc)) + :key #'slot-definition-name))) (retrieval (gethash :retrieval tdbi)) + (tsc (gethash :join-class tdbi)) + (ts-view-table (view-table (find-class tsc))) (jq (join-qualifier class object slot-def)) (key (slot-value object (gethash :home-key dbi)))) + (when jq (ecase retrieval (:immediate (let ((res - (find-all (list ts) + (find-all (list tsc) :inner-join (sql-expression :table jc-view-table) :on (sql-operation '== @@ -667,7 +669,7 @@ ;; just fill in minimal slots (mapcar #'(lambda (k) - (let ((instance (make-instance ts :view-database (view-database object))) + (let ((instance (make-instance tsc :view-database (view-database object))) (jcc (make-instance jc :view-database (view-database object))) (fk (car k))) (setf (slot-value instance (gethash :home-key tdbi)) fk) @@ -742,24 +744,30 @@ maximum of MAX-LEN instances updated in each query." (let* ((keys (if max-len (subseq object-keys i (min (+ i query-len) n-object-keys)) object-keys)) - (results (find-all (list (gethash :join-class dbi)) - :where (make-instance 'sql-relational-exp - :operator 'in - :sub-expressions (list (sql-expression :attribute foreign-key) - keys)) - :result-types :auto - :flatp t))) + (results (unless (gethash :target-slot dbi) + (find-all (list (gethash :join-class dbi)) + :where (make-instance 'sql-relational-exp + :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))) - (let ((res (remove-if-not #'(lambda (obj) - (equal obj (slot-value - object - home-key))) - results - :key #'(lambda (res) - (slot-value res - foreign-key))))) + (let ((res (if results + (remove-if-not #'(lambda (obj) + (equal obj (slot-value + object + home-key))) + results + :key #'(lambda (res) + (slot-value res + foreign-key))) + + (progn + (when (gethash :target-slot dbi) + (fault-join-target-slot class object slotdef)))))) (when res (setf (slot-value object slotdef-name) (if (gethash :set dbi) res (car res)))))))))))))