[isidorus-cvs] r718 - in trunk/src: model rest_interface

[lgiessmann at common-lisp.net]

Author: lgiessmann
Date: Wed Aug 10 07:55:51 2011
New Revision: 718

Log:
trunk: rest-interface: fixed a bug when updating the serializatiuon cache of fragments after another topic was deleted that was bound to an association which referenced other topics/fragments

Modified:
   trunk/src/model/datamodel.lisp
   trunk/src/rest_interface/set-up-json-interface.lisp

Modified: trunk/src/model/datamodel.lisp
==============================================================================
--- trunk/src/model/datamodel.lisp	Wed Aug 10 03:37:39 2011	(r717)
+++ trunk/src/model/datamodel.lisp	Wed Aug 10 07:55:51 2011	(r718)
@@ -1577,7 +1577,7 @@
   (when (or (and (not source-locator) sl-provided-p)
 	    (and sl-provided-p
 		 (some (lambda (psi) (string-starts-with (uri psi) source-locator))
-		       (psis top :revision 0))))
+		       (psis top :revision revision))))
     (mapc (lambda(psi)(mark-as-deleted psi :revision revision
 				       :source-locator source-locator))
 	  (psis top :revision revision))

Modified: trunk/src/rest_interface/set-up-json-interface.lisp
==============================================================================
--- trunk/src/rest_interface/set-up-json-interface.lisp	Wed Aug 10 03:37:39 2011	(r717)
+++ trunk/src/rest_interface/set-up-json-interface.lisp	Wed Aug 10 07:55:51 2011	(r718)
@@ -609,7 +609,8 @@
 					    (when (eql (d:topic fragment) result)
 					      (elephant:drop-instance fragment)))
 				      (elephant:get-instances-by-value
-				       'd:FragmentC 'd:topic result)))
+				       'd:FragmentC 'd:topic result))
+				 (update-fragments result rev))
 				((typep result 'd:AssociationC)
 				 (let ((players
 					(delete-if
@@ -654,6 +655,49 @@
 	(setf (hunchentoot:return-code*) hunchentoot:+http-bad-request+))))
 
 
+
+(defun update-fragments(deleted-topic delete-revision)
+  "Updates all fragments of topics that directly and indireclty
+   related to the delete-topic."
+  (declare (TopicC deleted-topic)
+	   (Integer delete-revision))
+  (let* ((rev (1- delete-revision))
+	 (all-tops
+	  (append
+	   (let ((assocs
+		  (map 'list (lambda(role)
+			       (d:parent role :revision rev))
+		       (d:player-in-roles deleted-topic :revision rev))))
+	     (loop for assoc in assocs
+		append (loop for role in (roles assoc :revision rev)
+			  collect (d:player role :revision rev))))
+	   (let ((items
+		  (append (used-as-theme deleted-topic :revision rev)
+			  (used-as-type deleted-topic :revision rev))))
+	     (loop for item in items
+		when (or (typep item 'NameC) (typep item 'OccurrenceC))
+		collect (parent item :revision rev)
+		when (or (typep item 'RoleC) (typep item 'AssociationC))
+		append (let ((inst (if (typep item 'AssociationC)
+				       item
+				       (d:parent item :revision rev))))
+			 (loop for role in (roles inst :revision rev)
+			    collect (d:player role :revision rev)))))))
+	 (fragments
+	  (delete-if #'null
+		     (map 'list (lambda(top)
+				  (elephant:get-instance-by-value
+				   'd:FragmentC 'd::topic top))
+			  (delete-duplicates
+			   (delete deleted-topic
+				   (delete-if #'null all-tops)))))))
+    (map nil (lambda(frg)
+	       (setf (slot-value frg 'd::serializer-cache) nil)
+	       (d:serialize-fragment frg (fragment-serializer)))
+	 fragments)))
+			       
+
+
 (defun return-latest-revision ()
   "Returns an integer that represents the latest revision that
    is used in the storage."