Changeset 902 for branches/gdl-frontend/src

Timestamp:

09/14/11 11:33:04 (14 years ago)

Author:

lgiessmann

Message:

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

Location:

branches/gdl-frontend/src

Files:

• json/JTM/jtm_importer.lisp (modified) (1 diff)
• rest_interface/set-up-gdl-interface.lisp (modified) (1 diff)

branches/gdl-frontend/src/json/JTM/jtm_importer.lisp ¶

@@ -408 +408 @@
     (dolist (occ top-occs)
       (add-occurrence top occ :revision revision))
+    (when create-fragment
+      (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")
-    (when create-fragment
-      (create-latest-fragment-of-topic top))
     top))
 

branches/gdl-frontend/src/rest_interface/set-up-gdl-interface.lisp ¶

@@ -124 +124 @@
                                             :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+)