r10794: 30 Oct 2005 Kevin Rosenberg <kevin@rosenberg.net>

        * 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 2cd38be2b778726331436d06b794fdd5a1588919..cf2e75c95951013e05ceff0fa1d637dedc65f243 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+30 Oct 2005  Kevin Rosenberg <kevin@rosenberg.net>
+       * 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 <kevin@rosenberg.net>
        * Version 3.3.2
        * sql/expressions.lisp: Avoid parenthesis on multiple group-by fields

diff --git a/debian/changelog b/debian/changelog
index 5a1944838f64c1cf0586010ea5b07390812715ed..ededa47f6d5f709953eb11130a32034cca76483e 100644 (file)
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,9 @@
+cl-sql (3.3.3-1) unstable; urgency=low
+
+  * New upstream
+
+ -- Kevin M. Rosenberg <kmr@debian.org>  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 187694dcacb5011d28b6900ffd186f0d20e058af..58622ae9304baff6f596074eb98e8e83187144ba 100644 (file)
--- 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)))))))))))))