[isidorus-cvs] r720 - in trunk/src: json/isidorus-json rest_interface

[lgiessmann at common-lisp.net]

Author: lgiessmann
Date: Fri Aug 12 01:43:53 2011
New Revision: 720

Log:
trunk: rest-interface: fixed a potential bug => if a foreign association is contained in a fragment, i.e. an association that is not bound to the actual main topic of the passed fragment, the corresponding fragments of all players of the foreign associations are updated

Modified:
   trunk/src/json/isidorus-json/json_importer.lisp
   trunk/src/rest_interface/set-up-json-interface.lisp

Modified: trunk/src/json/isidorus-json/json_importer.lisp
==============================================================================
--- trunk/src/json/isidorus-json/json_importer.lisp	Wed Aug 10 12:45:20 2011	(r719)
+++ trunk/src/json/isidorus-json/json_importer.lisp	Fri Aug 12 01:43:53 2011	(r720)
@@ -38,7 +38,8 @@
 	(let ((psi-of-topic
 	       (let ((psi-uris (getf topic-values :subjectIdentifiers)))
 		 (when psi-uris
-		   (first psi-uris)))))
+		   (first psi-uris))))
+	      (committed-associations nil))
 	  (elephant:ensure-transaction (:txn-nosync nil) 
 	    (xtm-importer:with-tm (rev xtm-id (first tm-ids))
 	      (loop for topicStub-values in
@@ -47,10 +48,20 @@
 				  :xtm-id xtm-id))
 	      (json-merge-topic topic-values rev :tm xtm-importer::tm :xtm-id xtm-id)
 	      (loop for association-values in associations-values
-		 do (json-to-association association-values rev
-					 :tm xtm-importer::tm))))
+		 do (push (json-to-association association-values rev
+					       :tm xtm-importer::tm)
+			  committed-associations))))
 	  (when psi-of-topic
-	    (create-latest-fragment-of-topic psi-of-topic)))))))
+	    (let* ((frag (create-latest-fragment-of-topic psi-of-topic))
+		   (foreign-assocs
+		    (nset-difference
+		     committed-associations
+		     (map 'list (lambda(role)
+				  (parent role :revision rev))
+			  (player-in-roles (topic frag) :revision rev)))))
+	      (list :fragment frag
+		    :foreign-associations foreign-assocs))))))))
+		  
 
 
 (defun json-to-association (json-decoded-list start-revision

Modified: trunk/src/rest_interface/set-up-json-interface.lisp
==============================================================================
--- trunk/src/rest_interface/set-up-json-interface.lisp	Wed Aug 10 12:45:20 2011	(r719)
+++ trunk/src/rest_interface/set-up-json-interface.lisp	Fri Aug 12 01:43:53 2011	(r720)
@@ -501,11 +501,15 @@
 					    :force-text t)))
 	    (with-writer-lock
 	      (handler-case
-		  (let ((frag (json-importer:import-from-isidorus-json json-data)))
-		    (when frag
-		      (push-to-cache (d:topic frag))
-		      (update-list (d:topic frag)
-				   (d:psis (d:topic frag) :revision 0))))
+		  (let ((result (json-importer:import-from-isidorus-json json-data)))
+		    (when (getf result :fragment)
+		      (update-fragments-after-commit
+		       (getf result :fragment)
+		       (getf result :foreign-associations))
+		      (push-to-cache (d:topic (getf result :fragment)))
+		      (update-list (d:topic (getf result :fragment))
+				   (d:psis (d:topic (getf result :fragment))
+					   :revision 0))))
 		(condition (err)
 		  (progn
 		    (setf (hunchentoot:return-code*)
@@ -515,6 +519,60 @@
 	(setf (hunchentoot:return-code*) hunchentoot:+http-bad-request+))))
 
 
+(defun update-fragments-after-commit (new-fragment foreign-associations)
+  "Deleted all old fragment that belongs to the topic that is bound to
+   the passed new-fragment. Deletes and creates a new fragment of all
+   players of any association of the passed list foreign-associations."
+  (declare (FragmentC new-fragment)
+	   (List foreign-associations))
+  (map 'list #'elephant:drop-instance
+       (delete new-fragment
+	       (elephant:get-instances-by-value
+		'd:FragmentC 'd::topic (d:topic new-fragment))))
+  (let* ((rev (d:revision new-fragment))
+	 (tops
+	  (loop for assoc in foreign-associations
+	     append (loop for role in (d:roles assoc :revision rev)
+		       collect (d:player role :revision rev)))))
+    (map 'list (lambda(top)
+		 (map 'list #'elephant:drop-instance
+		      (elephant:get-instances-by-value
+		       'd:FragmentC 'd::topic top))
+		 (serialize-fragment (d:create-latest-fragment-of-topic top)
+				     (fragment-serializer)))
+	 (delete-duplicates (delete-if #'null tops)))))
+    
+
+(defun update-fragments-after-commit (new-fragment)
+  "Removes all fragments that belongs to the same topic that the
+   new fragment is bound to, but are older than the new fragment.
+   Updates all fragments that are bound to topics that are players
+   of associations contained in the new fragment."
+  (declare (FragmentC new-fragment))
+  (map nil (lambda(frg)
+	     (when (not (eql frg new-fragment))
+	       (elephant:drop-instance frg)))
+       (elephant:get-instances-by-value
+	'd:FragmentC 'd::topic (d:topic new-fragment)))
+  (let* ((rev (d:revision new-fragment))
+	 (top (d:topic new-fragment))
+	 (tops-to-update
+	  (delete
+	   top
+	   (let ((assocs (map 'list (lambda(role)
+				      (d:parent role :revision rev))
+			      (d:player-in-roles top :revision rev))))
+	     (loop for assoc in assocs
+		append (loop for role in (d:roles assoc :revision rev)
+			  collect (d:player role :revision rev)))))))
+    (map nil (lambda(top)
+	       (map nil #'elephant:drop-instance
+		    (elephant:get-instances-by-value 'd:FragmentC 'd::topic top))
+	       (d:serialize-fragment (create-latest-fragment-of-topic top)
+				     (fragment-serializer)))
+	 tops-to-update)))
+
+
 (defun return-topic-summaries(&optional param)
   "returns a summary of the requested topics"
   (declare (ignorable param))
@@ -610,7 +668,7 @@
 					      (elephant:drop-instance fragment)))
 				      (elephant:get-instances-by-value
 				       'd:FragmentC 'd:topic result))
-				 (update-fragments result rev))
+				 (update-fragments-after-delete result rev))
 				((typep result 'd:AssociationC)
 				 (let ((players
 					(delete-if
@@ -656,7 +714,7 @@
 
 
 
-(defun update-fragments(deleted-topic delete-revision)
+(defun update-fragments-after-delete(deleted-topic delete-revision)
   "Updates all fragments of topics that directly and indireclty
    related to the delete-topic."
   (declare (TopicC deleted-topic)