[isidorus-cvs] r319 - in branches/new-datamodel/src: model unit_tests xml/rdf

Lukas Giessmann lgiessmann at common-lisp.net
Sat Oct 2 09:20:26 UTC 2010


Author: lgiessmann
Date: Sat Oct  2 05:20:25 2010
New Revision: 319

Log:
new-datamodel: changed "changed-p", so a ReifiableConstructC also changed when an ItemIdentifierC or a reifier was marked-as-deleted one revision ago; a NameC changed also when a variant was marked-as-deleted one revsion ago; a TopicC changed when any identifier or CharacteristicC was marked-as-deleted one revision ago; an AssociationC changed also when a RoleC was marked-as-deleted one revision ago

Modified:
   branches/new-datamodel/src/model/changes.lisp
   branches/new-datamodel/src/unit_tests/versions_test.lisp
   branches/new-datamodel/src/xml/rdf/exporter.lisp

Modified: branches/new-datamodel/src/model/changes.lisp
==============================================================================
--- branches/new-datamodel/src/model/changes.lisp	(original)
+++ branches/new-datamodel/src/model/changes.lisp	Sat Oct  2 05:20:25 2010
@@ -151,6 +151,7 @@
   (:documentation "Has the topic map construct changed in a given revision?
                    'Changed' can mean: 
     * newly created
+    * deletion of an element
     * modified through the addition or removal of identifiers
     * (for associations) modified through the addition or removal of
        identifiers in the association or one of its roles
@@ -210,15 +211,36 @@
 	  (initial-version-p version-info)))))
 
 
+(defgeneric end-revision-p (construct revision)
+  (:documentation "A helper function for changed-p. It returns the latest
+                   version-info if the passed versioned-construct was
+                   marked-as-deleted in the version that is given.")
+  (:method ((construct VersionedConstructC) (revision integer))
+    (let ((version-info (find revision (versions construct)
+			      :key #'end-revision :test #'=)))
+      (when (and version-info
+		 (not
+		  (find-if
+		   #'(lambda(vi)
+		       (or (> (end-revision vi) (end-revision version-info))
+			   (= (end-revision vi) 0)))
+		   (versions construct))))
+	version-info))))
+
+
 (defmethod changed-p ((construct ReifiableConstructC) (revision integer))
   "Returns t if a ReifiableConstructC changed in the given version, i.e.
    an item-identifier or reifier was added to the construct itself."
-  (some #'(lambda(vc)
-	    (changed-p vc revision))
-	(union (item-identifiers construct :revision revision)
-	       (let ((reifier-top (reifier construct :revision revision)))
-		 (when reifier-top
-		   (list reifier-top))))))
+  (or (some #'(lambda(vc)
+		(changed-p vc revision))
+	    (union (item-identifiers construct :revision revision)
+		   (let ((reifier-top (reifier construct :revision revision)))
+		     (when reifier-top
+		       (list reifier-top)))))
+      (some #'(lambda(vc)
+		(end-revision-p vc revision))
+	    (union (slot-p construct 'item-identifiers)
+		   (slot-p construct 'reifier)))))
 
 
 (defmethod changed-p ((construct NameC) (revision integer))
@@ -227,7 +249,10 @@
   (or (call-next-method)
       (some #'(lambda(var)
 		(changed-p var revision))
-	    (variants construct :revision revision))))
+	    (variants construct :revision revision))
+      (some #'(lambda(vc)
+		(end-revision-p vc revision))
+	    (slot-p construct 'variants))))
 
 
 (defmethod changed-p ((construct TopicC) (revision integer))
@@ -254,7 +279,15 @@
 	  (let ((ra (find-if #'(lambda(reifier-assoc)
 				 (eql (reifiable-construct reifier-assoc) rc))
 			     (slot-p construct 'reified-construct))))
-	    (changed-p ra revision))))))
+	    (changed-p ra revision))))
+      (some #'(lambda(vc)
+		(end-revision-p vc revision))
+	    (union (union (union (slot-p construct 'psis)
+				 (slot-p construct 'locators))
+			  (union (slot-p construct 'names)
+				 (slot-p construct 'occurrences)))
+		   (slot-p construct 'reified-construct)))))
+	   
 
 
 (defmethod changed-p ((construct AssociationC) (revision integer))
@@ -263,7 +296,10 @@
   (or (call-next-method)
       (some #'(lambda(role)
 		(changed-p role revision))
-	    (roles construct :revision revision))))
+	    (roles construct :revision revision))
+      (some #'(lambda(vc)
+		(end-revision-p vc revision))
+	    (slot-p construct 'roles))))
 
 
 (defpclass FragmentC ()

Modified: branches/new-datamodel/src/unit_tests/versions_test.lisp
==============================================================================
--- branches/new-datamodel/src/unit_tests/versions_test.lisp	(original)
+++ branches/new-datamodel/src/unit_tests/versions_test.lisp	Sat Oct  2 05:20:25 2010
@@ -331,8 +331,9 @@
       (is-false (changed-p subject-geodata-assoc fixtures::revision3))
       (is-true (changed-p norwegian-curriculum-assoc fixtures::revision1))
       (is-true (changed-p norwegian-curriculum-assoc fixtures::revision2))
-      )))
-      ;(is-true (changed-p norwegian-curriculum-assoc fixtures::revision3)))))
+      (is-true (changed-p norwegian-curriculum-assoc fixtures::revision3))
+      (delete-name service-topic service-name :revision fixtures::revision3)
+      (is-true (changed-p service-topic fixtures::revision3)))))
 
 
 (test test-mark-as-deleted ()

Modified: branches/new-datamodel/src/xml/rdf/exporter.lisp
==============================================================================
--- branches/new-datamodel/src/xml/rdf/exporter.lisp	(original)
+++ branches/new-datamodel/src/xml/rdf/exporter.lisp	Sat Oct  2 05:20:25 2010
@@ -60,7 +60,7 @@
 
 
 (defun init-*ns-map* ()
-  "Initializes the variable *ns-map* woith some prefixes and corresponding
+  "Initializes the variable *ns-map* with some prefixes and corresponding
    namepsaces. So the predifend namespaces are not contain ed twice."
   (setf *ns-map* (list
 		  (list :prefix "isi"




More information about the Isidorus-cvs mailing list