Author: lgiessmann Date: Thu Apr 22 06:51:39 2010 New Revision: 285
Log: new-datamodel: adapted the "mark-as-deleted" and "marked-as-deleted-p" methods to the new datamodel; added some unit-tests for mergeing topics
Modified: branches/new-datamodel/src/model/changes.lisp branches/new-datamodel/src/model/datamodel.lisp branches/new-datamodel/src/unit_tests/datamodel_test.lisp
Modified: branches/new-datamodel/src/model/changes.lisp ============================================================================== --- branches/new-datamodel/src/model/changes.lisp (original) +++ branches/new-datamodel/src/model/changes.lisp Thu Apr 22 06:51:39 2010 @@ -7,7 +7,6 @@ ;;+-----------------------------------------------------------------------------
-;-*- standard-indent:2; tab-width:2; indent-tabs-mode:nil -*- (in-package :datamodel)
(defun get-all-revisions () @@ -36,19 +35,28 @@ (sort revision-set #'<)))
-(defun find-associations-for-topic (top) - "find all associations of this topic" +(defun find-all-associations-for-topic (top &key (revision *TM-REVISION*)) + "Finds all associations for a topic." + (remove-duplicates + (map 'list #'(lambda(role) + (parent role :revision revision)) + (player-in-roles top :revision revision)))) + + +(defun find-associations-for-topic (top &key (revision *TM-REVISION*)) + "Finds all associations of this topic except type-instance-associations." (let ((type-instance-topic (d:identified-construct (elephant:get-instance-by-value 'PersistentIdC 'uri "http://psi.topicmaps.org/iso13250/model/type-instance")))) - (remove - type-instance-topic - (remove-duplicates - (map 'list #'parent (player-in-roles top))) - :key #'instance-of))) + (remove-if + #'(lambda(assoc) + (when (eql (instance-of assoc :revision revision) + type-instance-topic) + t)) + (find-all-associations-for-topic top :revision revision))))
(defgeneric find-referenced-topics (construct) @@ -208,53 +216,9 @@ 'unique-id unique-id))
-;(defgeneric mark-as-deleted (construct &key source-locator revision) -; (:documentation "Mark a construct as deleted if it comes from the source indicated by -;source-locator")) - -;(defmethod mark-as-deleted ((construct TopicMapConstructC) &key source-locator revision) -; "Mark a topic as deleted if it comes from the source indicated by -;source-locator" -; (declare (ignorable source-locator)) -; (let -; ((last-version ;the last active version -; (find 0 (versions construct) :key #'end-revision))) -; (when last-version -; (setf (end-revision last-version) revision)))) -; -;(defmethod mark-as-deleted :around ((ass AssociationC) &key source-locator revision) -; "Mark an association and its roles as deleted" -; (mapc (lambda (role) (mark-as-deleted role :revision revision :source-locator source-locator)) -; (roles ass)) -; (call-next-method)) -; -;(defmethod mark-as-deleted :around ((top TopicC) &key source-locator revision) -; "Mark a topic as deleted if it comes from the source indicated by -;source-locator" -; ;;Part 1b, 1.4.3.3.1: -; ;; Let SP be the value of the ServerSourceLocatorPrefix element in the ATOM feed F -; ;; * Let SI be the value of TopicSI element in ATOM entry E -; ;; * feed F contains E -; ;; * entry E references topic fragment TF -; ;; * Let LTM be the local topic map -; ;; * Let T be the topic in LTM that has a subjectidentifier that matches SI -; ;; * For all names, occurrences and associations in which T plays a role, TMC -; ;; * Delete all SrcLocators of TMC that begin with SP. If the count of srclocators on TMC = 0 then delete TMC -; ;; * Merge in the fragment TF using SP as the base all generated source locators. -; -; (when -; (some (lambda (psi) (string-starts-with (uri psi) source-locator)) (psis top)) -; (mapc (lambda (name) (mark-as-deleted name :revision revision :source-locator source-locator)) -; (names top)) -; (mapc (lambda (occ) (mark-as-deleted occ :revision revision :source-locator source-locator)) -; (occurrences top)) -; (mapc (lambda (ass) (mark-as-deleted ass :revision revision :source-locator source-locator)) -; (find-associations-for-topic top)) -; (call-next-method))) - (defgeneric add-source-locator (construct &key source-locator revision) (:documentation "adds an item identifier to a given construct based on the source -locator and an internally generated id (ideally a uuid)")) + locator and an internally generated id (ideally a uuid)"))
(defmethod add-source-locator ((construct ReifiableConstructC) &key source-locator revision) (declare (ignorable revision))
Modified: branches/new-datamodel/src/model/datamodel.lisp ============================================================================== --- branches/new-datamodel/src/model/datamodel.lisp (original) +++ branches/new-datamodel/src/model/datamodel.lisp Thu Apr 22 06:51:39 2010 @@ -839,6 +839,15 @@
;;; generic definitions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defgeneric mark-as-deleted (construct &key source-locator revision) + (:documentation "Mark a construct as deleted if it comes from the source + indicated by source-locator")) + + +(defgeneric marked-as-deleted-p (construct) + (:documentation "Returns t if the construct was marked-as-deleted.")) + + (defgeneric find-self-or-equal (construct parent-construct &key revision) (:documentation "Returns the construct 'construct' if is owned by the parent-construct or an equal construct or nil if there @@ -875,11 +884,6 @@ Variants are deleted from names by calling delete-variant."))
-(defgeneric mark-as-deleted (construct &key source-locator revision) - (:documentation "Mark a construct as deleted if it comes from the source - indicated by source-locator")) - - (defgeneric find-oldest-construct (construct-1 construct-2) (:documentation "Returns the construct which owns the oldes version info. If a construct is not a versioned construct the oldest @@ -1089,14 +1093,11 @@ :versioned-construct construct))))))))
-(defgeneric marked-as-deleted-p (construct) - (:documentation "Returns t if the construct was marked-as-deleted.") - (:method ((construct VersionedConstructC)) - (if (find-if #'(lambda(vi) +(defmethod marked-as-deleted-p ((construct VersionedConstructC)) + (unless (find-if #'(lambda(vi) (= (end-revision vi) 0)) (versions construct)) - nil - t))) + t))
(defmethod mark-as-deleted ((construct VersionedConstructC) @@ -1107,7 +1108,7 @@ (find 0 (versions construct) :key #'end-revision))) (when last-version (setf (end-revision last-version) revision)))) - +
;;; TopicMapconstructC (defgeneric strictly-equivalent-constructs (construct-1 construct-2 @@ -1146,6 +1147,27 @@
;;; PointerC +(defmethod mark-as-deleted ((construct PointerC) &key source-locator revision) + "Marks the last active relation between a pointer and its parent construct + as deleted." + (declare (ignorable source-locator)) + (let ((owner (identified-construct construct :revision 0))) + (when owner + (cond ((typep construct 'PersistentIdC) + (delete-psi owner construct :revision revision)) + ((typep construct 'SubjectLocatorC) + (delete-locator owner construct :revision revision)) + ((typep construct 'ItemIdentifierC) + (delete-item-identifier owner construct :revision revision)) + ((typep construct 'TopicIdentificationC) + (delete-topic-identifier owner construct :revision revision)))))) + + +(defmethod marked-as-deleted-p ((construct PointerC)) + (unless (identified-construct construct :revision 0) + t)) + + (defmethod find-oldest-construct ((construct-1 PointerC) (construct-2 PointerC)) (let ((vi-1 (find-version-info (slot-p construct-1 'identified-construct))) (vi-2 (find-version-info (slot-p construct-2 'identified-construct)))) @@ -1371,6 +1393,44 @@
;;; TopicC +(defmethod mark-as-deleted :around ((top TopicC) + &key (source-locator nil sl-provided-p) + revision) + "Mark a topic as deleted if it comes from the source indicated by + source-locator" + ;;Part 1b, 1.4.3.3.1: + ;; Let SP be the value of the ServerSourceLocatorPrefix element in the ATOM feed F + ;; * Let SI be the value of TopicSI element in ATOM entry E + ;; * feed F contains E) + ;; * entry E references topic fragment TF + ;; * Let LTM be the local topic map + ;; * Let T be the topic in LTM that has a subjectidentifier that matches SI + ;; * For all names, occurrences and associations in which T plays a role, TMC + ;; * Delete all SrcLocators of TMC that begin with SP. If the count of srclocators on TMC = 0 then delete TMC + ;; * Merge in the fragment TF using SP as the base all generated source locators. + (when (or (and (not source-locator) sl-provided-p) + (and sl-provided-p + (some (lambda (psi) (string-starts-with (uri psi) source-locator)) + (psis top :revision 0)))) + (unless sl-provided-p + (mapc (lambda(psi)(mark-as-deleted psi :revision revision + :source-locator source-locator)) + (psis top :revision 0))) + (mapc (lambda(sl)(mark-as-deleted sl :revision revision + :source-locator source-locator)) + (locators top :revision 0)) + (mapc (lambda (name) (mark-as-deleted name :revision revision + :source-locator source-locator)) + (names top :revision 0)) + (mapc (lambda (occ) (mark-as-deleted occ :revision revision + :source-locator source-locator)) + (occurrences top :revision 0)) + (mapc (lambda (ass) (mark-as-deleted ass :revision revision + :source-locator source-locator)) + (find-all-associations-for-topic top :revision 0)) + (call-next-method))) + + (defmethod equivalent-constructs ((construct-1 TopicC) (construct-2 TopicC) &key (revision *TM-REVISION*)) (declare (integer revision)) @@ -2022,6 +2082,20 @@
;;; CharacteristicC +(defmethod mark-as-deleted ((construct CharacteristicC) &key source-locator revision) + "Marks the last active relation between a characteristic and its parent topic + as deleted." + (declare (ignorable source-locator)) + (let ((owner (parent construct :revision 0))) + (when owner + (delete-characteristic owner construct :revision revision)))) + + +(defmethod marked-as-deleted-p ((construct CharacteristicC)) + (unless (parent construct :revision 0) + t)) + + (defmethod find-self-or-equal ((construct CharacteristicC) (parent-construct TopicC) &key (revision *TM-REVISION*)) @@ -2405,6 +2479,14 @@
;;; AssociationC +(defmethod mark-as-deleted :around ((ass AssociationC) &key source-locator revision) + "Marks an association and its roles as deleted" + (mapc (lambda (role) + (mark-as-deleted role :revision revision :source-locator source-locator)) + (roles ass :revision 0)) + (call-next-method)) + + (defmethod equivalent-constructs ((construct-1 AssociationC) (construct-2 AssociationC) &key (revision *TM-REVISION*)) @@ -2527,6 +2609,20 @@
;;; RoleC +(defmethod mark-as-deleted ((construct RoleC) &key source-locator revision) + "Marks the last active relation between a role and its parent association + as deleted." + (declare (ignorable source-locator)) + (let ((owner (parent construct :revision 0))) + (when owner + (delete-role owner construct :revision revision)))) + + +(defmethod marked-as-deleted-p ((construct RoleC)) + (unless (parent construct :revision 0) + t)) + + (defmethod find-self-or-equal ((construct RoleC) (parent-construct AssociationC) &key (revision *TM-REVISION*)) (declare (integer revision)) @@ -2771,6 +2867,15 @@
;;; ReifiableConstructC +(defmethod mark-as-deleted :around ((construct ReifiableConstructC) + &key source-locator revision) + "Marks all item-identifiers of a given reifiable-construct as deleted." + (declare (ignorable source-locator)) + (call-next-method) + (dolist (ii (item-identifiers construct :revision 0)) + (delete-item-identifier construct ii :revision revision))) + + (defmethod check-for-duplicate-identifiers ((construct ReifiableConstructC) &key (revision *TM-REVISION*)) (declare (integer revision)) @@ -3739,7 +3844,7 @@ (declare (integer revision)) (let ((occs-to-move (occurrences source :revision revision))) (dolist (occ occs-to-move) - (delete-occurrence occ source :revision revision) + (delete-occurrence source occ :revision revision) (let ((equivalent-occ (find-if #'(lambda (destination-occ) (when @@ -3847,7 +3952,7 @@ (move-referenced-constructs newer-topic older-topic :revision revision) (move-reified-construct newer-topic older-topic :revision revision) (merge-changed-constructs older-topic :revision revision) - (mark-as-deleted newer-topic :revision revision) + (mark-as-deleted newer-topic :revision revision :source-locator nil) (when (exist-in-revision-history-? newer-topic) (delete-construct newer-topic)) older-topic))))
Modified: branches/new-datamodel/src/unit_tests/datamodel_test.lisp ============================================================================== --- branches/new-datamodel/src/unit_tests/datamodel_test.lisp (original) +++ branches/new-datamodel/src/unit_tests/datamodel_test.lisp Thu Apr 22 06:51:39 2010 @@ -81,10 +81,11 @@ :test-find-oldest-construct :test-move-referenced-constructs-ReifiableConstructC :test-move-referenced-constructs-NameC - :test-move-referenced-constructs-TopicC)) + :test-merge-constructs-TopicC-1))
;;TODO: test merge-constructs +;;TODO: test mark-as-deleted
@@ -2932,13 +2933,15 @@ (variants name-2 :revision rev-2)))))))))
-(test test-move-referenced-constructs-TopicC () +(test test-merge-constructs-TopicC-1 () "Tests the generic move-referenced-constructs corresponding to TopicC." (with-fixture with-empty-db (*db-dir*) (let ((rev-1 100) - (rev-2 200)) + (rev-2 200) + (rev-3 300)) (let ((ii-1 (make-construct 'ItemIdentifierC :uri "ii-1")) (ii-2 (make-construct 'ItemIdentifierC :uri "ii-2")) + (ii-3 (make-construct 'ItemIdentifierC :uri "ii-3")) (sl-1 (make-construct 'SubjectLocatorC :uri "sl-1")) (sl-2 (make-construct 'SubjectLocatorC :uri "sl-2")) (psi-1 (make-construct 'PersistentIdC :uri "psi-1")) @@ -2956,7 +2959,7 @@ :charvalue "var-1" :themes (list theme-1))) (variant-2 (make-construct 'VariantC - :start-revision rev-1 + :start-revision rev-2 :charvalue "var-2" :themes (list theme-2))) (variant-3 (make-construct 'VariantC @@ -2973,7 +2976,8 @@ :charvalue "occ-2" :instance-of type-2)) (occ-3 (make-construct 'OccurrenceC - :start-revision rev-1 + :start-revision rev-2 + :item-identifiers (list ii-3) :charvalue "occ-1" :instance-of type-1 :themes (list theme-1)))) @@ -2981,8 +2985,68 @@ :start-revision rev-1 :charvalue "name-1" :instance-of type-1)) - ) - )))))) + (name-2 (make-construct 'NameC + :start-revision rev-2 + :charvalue "name-2" + :instance-of type-1 + :variants (list variant-1 variant-2))) + (name-3 (make-construct 'NameC + :start-revision rev-1 + :charvalue "name-1" + :instance-of type-1 + :variants (list variant-3)))) + (let ((top-1 (make-construct 'TopicC + :start-revision rev-1 + :topic-identifiers (list tid-1) + :item-identifiers (list ii-1) + :locators (list sl-1) + :psis (list psi-1) + :names (list name-1 name-2) + :occurrences (list occ-1 occ-2))) + (top-2 (make-construct 'TopicC + :start-revision rev-2 + :topic-identifiers (list tid-2) + :item-identifiers (list ii-2) + :locators (list sl-2) + :psis (list psi-2) + :names (list name-3) + :occurrences (list occ-3)))) + (setf *TM-REVISION* rev-3) + (let ((top (d::merge-constructs top-1 top-2 :revision rev-3))) + (is (eql top top-1)) + (is-true (d::marked-as-deleted-p top-2)) + (is-false (append (psis top-2) (item-identifiers top-2) + (locators top-2) (topic-identifiers top-2) + (names top-2) (occurrences top-2))) + (setf *TM-REVISION* rev-2) + (is (= (length (append (psis top-2) (item-identifiers top-2) + (locators top-2) (topic-identifiers top-2) + (names top-2) (occurrences top-2))) + 6)) + (setf *TM-REVISION* rev-3) + (is-false (set-exclusive-or (list ii-1 ii-2) + (item-identifiers top-1))) + (is-false (set-exclusive-or (list sl-1 sl-2) (locators top-1))) + (is-false (set-exclusive-or (list psi-1 psi-2) (psis top-1))) + (is-false (set-exclusive-or (list tid-1 tid-2) + (topic-identifiers top-1))) + (is-false (set-exclusive-or (list psi-1) + (psis top-1 :revision rev-2))) + (is-false (set-exclusive-or (list name-1 name-2) + (names top-1))) + (is-false (set-exclusive-or (variants name-1) + (list variant-3))) + (is-false (variants name-3)) + (is-false (set-exclusive-or (occurrences top-1) + (list occ-1 occ-2))) + (is-false (set-exclusive-or (item-identifiers occ-1) + (list ii-3))) + (is-false (item-identifiers occ-3)) + (is-true (d::marked-as-deleted-p name-3)) + (is-true (d::marked-as-deleted-p occ-3)))))))))) + + +
(defun run-datamodel-tests() @@ -3043,5 +3107,5 @@ (it.bese.fiveam:run! 'test-find-oldest-construct) (it.bese.fiveam:run! 'test-move-referenced-constructs-ReifiableConstructC) (it.bese.fiveam:run! 'test-move-referenced-constructs-NameC) - (it.bese.fiveam:run! 'test-move-referenced-constructs-TopicC) + (it.bese.fiveam:run! 'test-merge-constructs-TopicC-1) ) \ No newline at end of file