r9951: Automated commit for Debian build of clsql upstream-version-3.0.1

diff --git a/ChangeLog b/ChangeLog
index 9935200ec3a5acf56e20449f44a70b9dd180d74f..c91e6883be1e8ee2eadc09ad48a96c5d04b579df 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+01 Sep 2004 Kevin Rosenberg <kevin@rosenberg.net>
+       * Version 3.0.1 Release
+       * tests/test-init.lisp: Add second join class to employee-address
+       to test a class with two join slots.
+       * sql/oodml.lisp: Fix find-all function for a class with multiple
+       join slots
+       * TODO: Remove need to test/fix multiple join classes
+       
 27 Aug 2004 Kevin Rosenberg <kevin@rosenberg.net>
        * db-mysql/Makefile, db-mysql/mysql-loader.lisp: accept patch
        from Jon Buffington for file locations on Darwin.

diff --git a/TODO b/TODO
index 190156e612c9fd9519603a4b837380a96aade403..87949bf9aecf63eeb625f3c18ea058ad82ae1e42 100644 (file)
--- a/TODO
+++ b/TODO
@@ -6,9 +6,6 @@ TESTS TO ADD
 * Number and Char field types
 * symbol slot
 * generalized-boolean slot
-* Table with two join slots (bug reported on clsql-help 8/13/04 about
-  SQL FROM clause missing the second join table and the WHERE clause
-  having an ',' instead of ' AND ' joining phrases.
 
 OPTIMIZATIONS
  

diff --git a/debian/changelog b/debian/changelog
index fa20f996e8fb64ba29f58123237737285517fa9b..cd9829607684f37a63f52fc111fdd21fbaf67276 100644 (file)
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,10 @@
+cl-sql (3.0.1-1) unstable; urgency=medium
+
+  * New upstream, important bug fix for classes with multiple join
+  classes
+
+ -- Kevin M. Rosenberg <kmr@debian.org>  Wed,  1 Sep 2004 12:16:40 -0600
+
 cl-sql (3.0.0-2) unstable; urgency=low
 
   * Change assignment in rules file 

diff --git a/sql/oodml.lisp b/sql/oodml.lisp
index 10bd5cf31beb46beaff278150fe44f0e9f25de66..c98342ed55ddf3ce220ec7c5d9ddf86ad3c8ff4d 100644 (file)
--- a/sql/oodml.lisp
+++ b/sql/oodml.lisp
@@ -812,10 +812,29 @@ maximum of MAX-LEN instances updated in each query."
                    (join-vals (subseq vals (list-length selects)))
                    (joins (mapcar #'(lambda (c) (when c (make-instance c :view-database database)))
                                   jclasses)))
-              ;;(format t "db-vals: ~S, join-values: ~S~%" db-vals join-vals)
+              
+              ;;(format t "joins: ~S~%db-vals: ~S~%join-values: ~S~%selects: ~S~%immediate-selects: ~S~%" 
+              ;;joins db-vals join-vals selects immediate-selects)
+              
               ;; use refresh keyword here 
               (setf obj (get-slot-values-from-view obj (mapcar #'car selects) db-vals))
-              (mapc #'(lambda (jc) (get-slot-values-from-view jc (mapcar #'car immediate-selects) join-vals))
+              (mapc #'(lambda (jo)
+                        ;; find all immediate-select slots and join-vals for this object
+                        (let* ((slots (class-slots (class-of jo)))
+                               (pos-list (remove-if #'null
+                                                    (mapcar
+                                                     #'(lambda (s)
+                                                         (position s immediate-selects
+                                                                   :key #'car
+                                                                   :test #'eq))
+                                                     slots))))
+                          (get-slot-values-from-view jo
+                                                     (mapcar #'car 
+                                                             (mapcar #'(lambda (pos)
+                                                                         (nth pos immediate-selects))
+                                                                     pos-list))
+                                                     (mapcar #'(lambda (pos) (nth pos join-vals))
+                                                             pos-list))))
                     joins)
               (mapc
                #'(lambda (jc) 
@@ -882,17 +901,22 @@ maximum of MAX-LEN instances updated in each query."
           (fullsels (apply #'append (mapcar #'append sels immediate-join-sels)))
           (sel-tables (collect-table-refs where))
           (tables (remove-if #'null
-                             (remove-duplicates (append (mapcar #'table-sql-expr sclasses)
-                                                        (mapcar #'(lambda (jcs)
-                                                                    (mapcan #'(lambda (jc)
-                                                                                (when jc (table-sql-expr jc)))
-                                                                            jcs))
-                                                                immediate-join-classes)
-                                                        sel-tables)
-                                                :test #'tables-equal)))
+                             (remove-duplicates
+                              (append (mapcar #'table-sql-expr sclasses)
+                                      (mapcan #'(lambda (jc-list)
+                                                  (mapcar
+                                                   #'(lambda (jc) (when jc (table-sql-expr jc)))
+                                                   jc-list))
+                                              immediate-join-classes)
+                                      sel-tables)
+                              :test #'tables-equal)))
           (order-by-slots (mapcar #'(lambda (ob) (if (atom ob) ob (car ob)))
-                                  (listify order-by))))
-                                
+                                  (listify order-by)))
+          (join-where nil))
+          
+
+      ;;(format t "sclasses: ~W~%ijc: ~W~%tables: ~W~%" sclasses immediate-join-classes tables)
+      
       (dolist (ob order-by-slots)
        (when (and ob (not (member ob (mapcar #'cdr fullsels)
                                   :test #'ref-equal)))
@@ -911,25 +935,34 @@ maximum of MAX-LEN instances updated in each query."
                    (mapcar
                     #'(lambda (jclass jslot)
                         (let ((dbi (view-class-slot-db-info jslot)))
-                          (setq where
-                                (append
-                                 (list (sql-operation '==
-                                                     (sql-expression
-                                                      :attribute (gethash :foreign-key dbi)
-                                                      :table (view-table jclass))
-                                                     (sql-expression
-                                                      :attribute (gethash :home-key dbi)
-                                                      :table (view-table vclass))))
-                                 (when where (listify where))))))
+                          (setq join-where
+                            (append
+                             (list (sql-operation '==
+                                                  (sql-expression
+                                                   :attribute (gethash :foreign-key dbi)
+                                                   :table (view-table jclass))
+                                                  (sql-expression
+                                                   :attribute (gethash :home-key dbi)
+                                                   :table (view-table vclass))))
+                             (when join-where (listify join-where))))))
                     jclasses jslots)))
              sclasses immediate-join-classes immediate-join-slots)
+      (when where 
+       (setq where (listify where)))
+      (cond
+       ((and where join-where)
+       (setq where (list (apply #'sql-and where join-where))))
+       ((and (null where) (> (length join-where) 1))
+       (setq where (list (apply #'sql-and join-where)))))
+      
       (let* ((rows (apply #'select 
                          (append (mapcar #'cdr fullsels)
                                  (cons :from 
                                        (list (append (when from (listify from)) 
                                                      (listify tables)))) 
                                  (list :result-types result-types)
-                                 (when where (list :where where))
+                                 (when where
+                                   (list :where where))
                                  args)))
             (instances-to-add (- (length rows) (length instances)))
             (perhaps-extended-instances

diff --git a/tests/test-init.lisp b/tests/test-init.lisp
index 5fc308d0b3128a4c1d51cd4fca11331e9df2c834..b1a89341af6499018a7025cc7c4b0474519b1649 100644 (file)
--- a/tests/test-init.lisp
+++ b/tests/test-init.lisp
@@ -164,6 +164,11 @@
            :db-info (:join-class address
                                  :home-key aaddressid
                                  :foreign-key addressid
+                                 :retrieval :immediate))
+   (employee :db-kind :join
+            :db-info (:join-class employee
+                                 :home-key aemplid
+                                 :foreign-key emplid
                                  :retrieval :immediate)))
   (:base-table "ea_join"))