Author: lgiessmann Date: Tue Apr 6 15:44:44 2010 New Revision: 265 Log: new-datamodel: added "merge-constructs" --> "TopicMapC" Modified: branches/new-datamodel/src/model/datamodel.lisp Modified: branches/new-datamodel/src/model/datamodel.lisp ============================================================================== --- branches/new-datamodel/src/model/datamodel.lisp (original) +++ branches/new-datamodel/src/model/datamodel.lisp Tue Apr 6 15:44:44 2010 @@ -155,11 +155,12 @@ (in-package :datamodel) -;;TODO: mark-as-deleted should call mark as deleted for every owned +;;TODO: mark-as-deleted should call mark-as-deleted for every owned ;; versioned-construct of the called construct -;;TODO: check for duplicate identifiers after topic-creation/merge ;;TODO: add: add-to-version-history (parent) to all ;; "add-<construct>"/"delete-<construct>" generics +;; ===>> adapt exist-in-revision-history +;;TODO: check for duplicate identifiers after topic-creation/merge ;;TODO: check merge-constructs in add-topic-identifier, ;; add-item-identifier/add-reifier (can merge the parent constructs ;; and the parent's parent construct + the reifier constructs), @@ -871,7 +872,7 @@ ;;; VersionedConstructC -(defgeneric does-not-exist-in-revision-history (versioned-construct) +(defgeneric exist-in-revision-history-? (versioned-construct) (:documentation "Returns t if the passed construct does not exist in any revision, i.e. the construct has no version-infos or exactly one whose start-revision is equal to its end-revision.") @@ -3527,7 +3528,7 @@ (move-reified-construct newer-topic older-topic :revision revision) (merge-changed-constructs older-topic :revision revision) (mark-as-deleted newer-topic :revision revision) - (when (does-not-exist-in-revision-history newer-topic) + (when (exist-in-revision-history-? newer-topic) (delete-construct newer-topic)) older-topic)))) @@ -3587,9 +3588,28 @@ older-char))))))) +(defmethod merge-constructs ((construct-1 TopicMapC) (construct-2 TopicMapC) + &key (revision *TM-REVISION*)) + (declare (integer revision)) + (if (eql construct-1 construct-2) + construct-1 + (let ((older-tm (find-oldest-construct construct-1 construct-2))) + (let ((newer-tm (if (eql older-tm construct-1) + construct-2 + construct-1))) + (move-referenced-constructs newer-tm older-tm :revision revision) + (dolist (top-or-assoc (append (topics newer-tm) (associations newer-tm))) + (add-to-tm top-or-assoc top-or-assoc)) + (add-to-version-history older-tm :start-revision revision) + (mark-as-deleted newer-tm :revision revision) + (when (exist-in-revision-history-? newer-tm) + (delete-construct newer-tm)) + older-tm)))) + + -;TODO: merge-constructs: RoleC (merge parents), AssociationC, TopicMapC, +;TODO: merge-constructs: RoleC (merge parents), AssociationC