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

[Lukas Giessmann]

Author: lgiessmann
Date: Sun Apr 18 08:50:40 2010
New Revision: 284

Log:
json+datamodel: modified the procedure of adding constructs to a new version-history --> currently a construct gets a new version-info if it was marked-as-deleted before or it has new item-identifiers

Modified:
   trunk/src/json/json_importer.lisp
   trunk/src/model/datamodel.lisp

Modified: trunk/src/json/json_importer.lisp
==============================================================================
--- trunk/src/json/json_importer.lisp	(original)
+++ trunk/src/json/json_importer.lisp	Sun Apr 18 08:50:40 2010
@@ -38,7 +38,7 @@
 		   (first psi-uris)))))
 	  (elephant:ensure-transaction (:txn-nosync nil) 
 	    (xml-importer:with-tm (rev xtm-id (first (getf fragment-values :tm-ids)))
-	      (loop for topicStub-values in (append topicStubs-values (list topic-values))
+	      (loop for topicStub-values in topicStubs-values
 		 do (json-to-stub topicStub-values rev :tm xml-importer::tm :xtm-id xtm-id))
 	      (json-merge-topic topic-values rev :tm xml-importer::tm :xtm-id xtm-id)
 	      (loop for association-values in associations-values
@@ -103,31 +103,29 @@
    elements from the json-decoded-list"
   (when json-decoded-list
     (elephant:ensure-transaction (:txn-nosync t) 
-      (let ((top
-	     (d:get-item-by-id
-	      (getf json-decoded-list :id)
-	      :revision start-revision
-	      :xtm-id xtm-id)))
+;      (let ((top
+;	     (d:get-item-by-id
+;	      (getf json-decoded-list :id)
+;	      :revision start-revision
+;	      :xtm-id xtm-id)))
+      (let ((top (json-to-stub json-decoded-list start-revision
+			       :tm tm :xtm-id xtm-id)))
 	(declare (list json-decoded-list))
 	(declare (integer start-revision))
 	(declare (TopicMapC tm))
 	(unless top
 	  (error "topic ~a could not be found" (getf json-decoded-list :id)))
-
 	(let ((instanceof-topics
 	       (remove-duplicates
 		(map 'list
 		     #'psis-to-topic
 		     (getf json-decoded-list :instanceOfs)))))
-
 	  (loop for name-values in (getf json-decoded-list :names)
 	     do (json-to-name name-values top start-revision))
-
 	  (loop for occurrence-values in (getf json-decoded-list :occurrences)
 	     do (json-to-occurrence occurrence-values top start-revision))
 	  (dolist (instanceOf-top instanceof-topics)
 	    (json-create-instanceOf-association instanceOf-top top start-revision :tm tm))
-;	  (add-to-topicmap tm top) ; will be done in "json-to-stub"
 	  top)))))
 
 
@@ -246,10 +244,8 @@
 	   (psis-to-topic (getf json-decoded-list :type))))
       (declare (list json-decoded-list))
       (declare (TopicC top))
-  
       (unless namevalue
         (error "A name must have exactly one namevalue"))
-
       (let ((name (make-construct 'NameC 
 				  :start-revision start-revision
 				  :topic top

Modified: trunk/src/model/datamodel.lisp
==============================================================================
--- trunk/src/model/datamodel.lisp	(original)
+++ trunk/src/model/datamodel.lisp	Sun Apr 18 08:50:40 2010
@@ -495,13 +495,14 @@
        (existing-construct (first (find-all-equivalent new-construct))))
     (if existing-construct
         (progn
-                                        ;change over new item identifiers to the old construct
-          (when  (copy-item-identifiers
-                  new-construct existing-construct)
-                 ;an existing construct other than a topic (which is handled
-                 ;separatedly below) has changed only if it has received a new
-                 ;item identifier
-            (add-to-version-history existing-construct :start-revision start-revision))
+          ;change over new item identifiers to the old construct
+	  ;the version-history is also changed if the construct was
+          ;marked-as-deleted before
+	  (when (or (copy-item-identifiers new-construct existing-construct)
+		    (not (find-most-recent-revision existing-construct)))
+	    (add-to-version-history existing-construct
+				    :start-revision start-revision))
+
           (delete-construct new-construct)
           existing-construct)
         (progn