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"))))))