X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=sql%2Fobjects.lisp;h=adaf9793631cb57363301b22ef09021e6d5a4d5c;hp=e72e53aa8fc5247d68960d872e7041abc3978b20;hb=1f4aee256a7a46f6501f9db7798874307c88e5f7;hpb=90011694c27b5b22673a34cb6948a2a721a9b6cd

diff --git a/sql/objects.lisp b/sql/objects.lisp
index e72e53a..adaf979 100644
--- 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))