[isidorus-cvs] r641 - in trunk/src: json/isidorus-json model

lgiessmann at common-lisp.net lgiessmann at common-lisp.net
Mon Jul 18 20:24:52 UTC 2011


Author: lgiessmann
Date: Mon Jul 18 13:24:52 2011
New Revision: 641

Log:
trunk: fixed a bung in the UI and the json exporter, now the backend marks all data, i.e. type, item-identifiers, reifier, roles (players, item-identifiers, reifier, type) and scopes of an association as deleted + the json exporter does not export mark-as-deleted associations of a fragment object

Modified:
   trunk/src/json/isidorus-json/json_exporter.lisp
   trunk/src/model/datamodel.lisp

Modified: trunk/src/json/isidorus-json/json_exporter.lisp
==============================================================================
--- trunk/src/json/isidorus-json/json_exporter.lisp	Mon Jul 18 08:36:53 2011	(r640)
+++ trunk/src/json/isidorus-json/json_exporter.lisp	Mon Jul 18 13:24:52 2011	(r641)
@@ -353,18 +353,24 @@
 		       (concat (subseq j-topicStubs 0 (- (length j-topicStubs) 1)) "]"))
 		     "null")))
 	(associations
-	 (concat "\"associations\":"
-		 (if (associations instance)
-		     (let ((j-associations "["))
-		       (loop for item in (associations instance)
-			  do (push-string
-			      (concat (export-construct-as-isidorus-json-string
-				       item :xtm-id xtm-id
-				       :revision revision) ",")
-			      j-associations))
-		       (concat (subseq j-associations 0
-				       (- (length j-associations) 1)) "]"))
-		     "null")))
+	 (let ((filtered-assocs
+		(remove-null
+		 (map 'list #'(lambda(assoc)
+				(when (find-item-by-revision assoc revision)
+				  assoc))
+		      (associations instance)))))
+	   (concat "\"associations\":"
+		   (if filtered-assocs
+		       (let ((j-associations "["))
+			 (loop for item in filtered-assocs
+			    do (push-string
+				(concat (export-construct-as-isidorus-json-string
+					 item :xtm-id xtm-id
+					 :revision revision) ",")
+				j-associations))
+			 (concat (subseq j-associations 0
+					 (- (length j-associations) 1)) "]"))
+		       "null"))))
 	(tm-ids
 	 (concat "\"tmIds\":"
 		 (let ((uris

Modified: trunk/src/model/datamodel.lisp
==============================================================================
--- trunk/src/model/datamodel.lisp	Mon Jul 18 08:36:53 2011	(r640)
+++ trunk/src/model/datamodel.lisp	Mon Jul 18 13:24:52 2011	(r641)
@@ -2765,6 +2765,9 @@
   (mapc (lambda (role)
 	  (mark-as-deleted role :revision revision :source-locator source-locator))
         (roles ass :revision revision))
+  (let ((type-top (instance-of ass :revision revision)))
+    (when type-top
+      (private-delete-type ass type-top :revision revision)))
   (call-next-method))
 
 




More information about the Isidorus-cvs mailing list