r9251:

diff --git a/ChangeLog b/ChangeLog
index 9f02b2a29003343b12c7296b9e59ca4216eb52fb..982bb0d7065656a7552b1f6def0f34f92a222470 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -3,7 +3,8 @@
        * sql/objects.lisp: Have :target-slot return of list of lists rather
        than a list of cons pairs to be conformant with CommonSQL.
        Make :target-slot much more efficient by using a SQL inner join
-       statement and just requiring one SQL query.
+       statement and just requiring one SQL query. Add :retrieval :deferrred
+       to target-slot joins. Add placeholder for update-objects-join.
        * sql/classes.lisp: Add :inner-join and :on slots to sql-query class
        and process them for query output-sql.
        

diff --git a/TODO b/TODO
index 04aa9d9cdf5d56fe31cd1280f109f092e22d6ddc..0bfb10dec3c45ca6ca950f1607c1e6f31f2a1e4d 100644 (file)
--- a/TODO
+++ b/TODO
@@ -7,6 +7,7 @@ TESTS TO ADD
 * Test bigint type
 * :db-constraint tests
 * *update-records-on-make-instance*
+* test :retrieval :deferred joins
 
 COMMONSQL SPEC
 
@@ -20,11 +21,10 @@ COMMONSQL SPEC
   
     SELECT 
       o keyword arg :refresh should function as advertised 
- 
- >> The object-oriented sql interface
 
     DEF-VIEW-CLASS
-      o implement :retrieval :immediate 
+      o Rework functioning of :immediate to be conformant. It 
+     works as expect with target-slot, but not without target-slot
 
  >> Symbolic SQL syntax 
 

diff --git a/sql/objects.lisp b/sql/objects.lisp
index e72e53aa8fc5247d68960d872e7041abc3978b20..adaf9793631cb57363301b22ef09021e6d5a4d5c 100644 (file)
--- a/sql/objects.lisp
+++ b/sql/objects.lisp
@@ -705,13 +705,6 @@ superclass of the newly-defined View Class."
 ;; ------------------------------------------------------------
 ;; Logic for 'faulting in' :join slots
 
-(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)))))
-
 ;; this works, but is inefficient requiring (+ 1 n-rows)
 ;; SQL queries
 #+ignore
@@ -742,27 +735,63 @@ superclass of the newly-defined View Class."
         (tdbi (view-class-slot-db-info 
                (find ts (class-slots (find-class jc))
                      :key #'slot-definition-name)))
+        (retrieval (gethash :retrieval tdbi))
         (jq (join-qualifier class object slot-def))
         (key (slot-value object (gethash :home-key dbi))))
     (when jq
-      (let ((res
-            (find-all (list ts) 
-                      :inner-join (sql-expression :attribute jc)
-                      :on (sql-operation 
-                           '==
-                           (sql-expression :attribute (gethash :foreign-key tdbi) :table ts)
-                           (sql-expression :attribute (gethash :home-key tdbi) :table jc))
-                      :where jq
-                      :result-types :auto)))
-       (mapcar #'(lambda (i)
-                   (let* ((instance (car i))
-                          (jcc (make-instance jc :view-database (view-database instance))))
-                     (setf (slot-value jcc (gethash :foreign-key dbi)) 
-                       key)
-                     (setf (slot-value jcc (gethash :home-key tdbi)) 
-                       (slot-value instance (gethash :foreign-key tdbi)))
+      (ecase retrieval
+       (:immediate
+        (let ((res
+               (find-all (list ts) 
+                         :inner-join (sql-expression :attribute jc)
+                         :on (sql-operation 
+                              '==
+                              (sql-expression :attribute (gethash :foreign-key tdbi) :table ts)
+                              (sql-expression :attribute (gethash :home-key tdbi) :table jc))
+                         :where jq
+                         :result-types :auto)))
+          (mapcar #'(lambda (i)
+                      (let* ((instance (car i))
+                             (jcc (make-instance jc :view-database (view-database instance))))
+                        (setf (slot-value jcc (gethash :foreign-key dbi)) 
+                              key)
+                        (setf (slot-value jcc (gethash :home-key tdbi)) 
+                              (slot-value instance (gethash :foreign-key tdbi)))
                      (list instance jcc)))
-               res)))))
+                  res)))
+       (:deferred
+           ;; just fill in minimal slots
+           (mapcar
+            #'(lambda (k)
+                (let ((instance (make-instance ts :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)
+                  (setf (slot-value jcc (gethash :foreign-key dbi)) 
+                        key)
+                  (setf (slot-value jcc (gethash :home-key tdbi)) 
+                        fk)
+                  (list instance jcc)))
+            (select (sql-expression :attribute (gethash :foreign-key tdbi) :table jc)
+                    :from (sql-expression :table jc)
+                    :where jq)))))))
+
+(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 :retrieval :immediate."
+  (when objects
+    (unless class-name
+      (class-name (class-of (first object))))
+    )
+  )
+
+  
+(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)))))
 
 (defun fault-join-slot (class object slot-def)
   (let* ((dbi (view-class-slot-db-info slot-def))