From: Kevin M. Rosenberg <kevin@rosenberg.net>
Date: Wed, 5 May 2004 17:52:04 +0000 (+0000)
Subject: r9251:
X-Git-Tag: v3.8.6~511
X-Git-Url: http://git.kpe.io/?p=clsql.git;a=commitdiff_plain;h=1f4aee256a7a46f6501f9db7798874307c88e5f7

r9251:
---

diff --git a/ChangeLog b/ChangeLog
index 9f02b2a..982bb0d 100644
--- 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 04aa9d9..0bfb10d 100644
--- 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 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))