[isidorus-cvs] r902 - in branches/gdl-frontend/src: json/JTM rest_interface

[lgiessmann at common-lisp.net]

Author: lgiessmann
Date: Wed Sep 14 04:33:04 2011
New Revision: 902

Log:
added additional fragment-updates when a construct is deleted, or when a new construct is committed

Modified:
   branches/gdl-frontend/src/json/JTM/jtm_importer.lisp
   branches/gdl-frontend/src/rest_interface/set-up-gdl-interface.lisp

Modified: branches/gdl-frontend/src/json/JTM/jtm_importer.lisp
==============================================================================
--- branches/gdl-frontend/src/json/JTM/jtm_importer.lisp	Wed Sep 14 04:11:14 2011	(r901)
+++ branches/gdl-frontend/src/json/JTM/jtm_importer.lisp	Wed Sep 14 04:33:04 2011	(r902)
@@ -407,9 +407,23 @@
       (add-name top name :revision revision))
     (dolist (occ top-occs)
       (add-occurrence top occ :revision revision))
-    (format t "t")
     (when create-fragment
-      (create-latest-fragment-of-topic top))
+      (let ((all-assocs
+	     (remove-null (map 'list (lambda(role)
+				       (parent role :revision revision))
+			       (player-in-roles top :revision revision)))))
+	(let ((all-tops
+	       (remove-null
+		(loop for assoc in all-assocs
+		   append (map 'list (lambda(role)
+				       (d:player role :revision revision))
+			       (roles assoc :revision revision))))))
+	  (map nil (lambda(top)
+		     (map nil #'elephant:drop-instance
+			  (elephant:get-instances-by-value 'FragmentC 'topic top))
+		     (create-latest-fragment-of-topic top))
+	       (append all-tops (list top))))))
+    (format t "t")
     top))
 
 

Modified: branches/gdl-frontend/src/rest_interface/set-up-gdl-interface.lisp
==============================================================================
--- branches/gdl-frontend/src/rest_interface/set-up-gdl-interface.lisp	Wed Sep 14 04:11:14 2011	(r901)
+++ branches/gdl-frontend/src/rest_interface/set-up-gdl-interface.lisp	Wed Sep 14 04:33:04 2011	(r902)
@@ -123,8 +123,37 @@
 		 (hunchentoot:raw-post-data :external-format external-format
 					    :force-text t)))
 	    (with-writer-lock
-	      (let ((result (jtm-delete-interface:mark-as-deleted-from-jtm
-			     json-data :revision (get-revision))))
+	      (let* ((rev (d:get-revision)) 
+		     (result (jtm-delete-interface:mark-as-deleted-from-jtm
+			      json-data :revision rev)))
+		(let ((tops
+		       (remove-null
+			(cond ((or (typep result 'OccurrenceC)
+				   (typep result 'NameC))
+			       (let ((top (parent result :revision (1- rev))))
+				 (when top (list top))))
+			      ((typep result 'VariantC)
+			       (let ((name (parent result :revision (1- rev))))
+				 (when name
+				   (let ((top (parent name :revision (1- rev))))
+				     (when top (list top))))))
+			      ((typep result 'AssociationC)
+			       (map 'list (lambda(role)
+					    (player role :revision (1- rev)))
+				    (roles result :revision (1- rev))))
+			      ((typep result 'TopicC)
+			       (let ((assocs
+				      (player-in-roles result :revision (1- rev))))
+				 (loop for assoc in assocs
+				    append (map 'list (lambda(role)
+							(player role :revision (1- rev)))
+						(roles assoc :revision (1- rev))))))))))
+		  (map nil (lambda(top)
+			     (let ((frags
+				    (elephant:get-instances-by-value 'd:FragmentC 'd:topic top)))
+			       (map nil #'elephant:drop-instance frags))
+			     (create-latest-fragment-of-topic top))
+		       tops))
 	       (unless result
 		 (setf (hunchentoot:return-code*) hunchentoot:+http-not-found+)
 		 (format nil "object not found"))))))