Author: lgiessmann Date: Thu Apr 1 16:31:29 2010 New Revision: 256

Log: new-datamodel: added the generic "merge-constructs" --> "ReifiableConstructC"

Modified: branches/new-datamodel/src/model/datamodel.lisp branches/new-datamodel/src/unit_tests/datamodel_test.lisp

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 1 16:31:29 2010 @@ -155,6 +155,9 @@ (in-package :datamodel)

+;;TODO: check for duplicate identifiers after topic-creation/merge +;;TODO: add: add-to-version-history (parent) to all +;; "add-<construct>"/"delete-<construct>" generics ;;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), @@ -3229,18 +3232,63 @@

-(defmethod merge-constructs ((construct-1 VariantC) (construct-2 VariantC) +(defmethod merge-constructs ((construct-1 ReifiableConstructC) + (construct-2 ReifiableConstructC) &key (revision *TM-REVISION*)) (declare (integer revision)) (if (eql construct-1 construct-2) construct-1 - (progn - (unless - (equivalent-constructs construct-1 construct-2 :revision revision) - (error "From merge-constructs(): the variants: ~a ~a are not mergable" - construct-1 construct-2)) - ;;... - ))) + (let ((older-construct (find-oldest-construct construct-1 construct-2))) + (let ((newer-construct (if (eql older-construct construct-1) + construct-2 + construct-1))) + (dolist (ii (item-identifiers newer-construct :revision revision)) + (delete-item-identifier newer-construct ii :revision revision) + (add-item-identifier older-construct ii :revision revision)) + (let ((reifier-1 (reifier newer-construct :revision revision)) + (reifier-2 (reifier older-construct :revision revision))) + (when reifier-1 + (delete-reifier newer-construct reifier-1 :revision revision) + (let ((merged-reifier + (if reifier-2 + (progn + (delete-reifier older-construct reifier-2 + :revision revision) + (merge-constructs reifier-1 reifier-2 + :revision revision)) + reifier-1))) + (add-reifier older-construct merged-reifier :revision revision)))) + (when (eql (type-of newer-construct) 'ReifiableConstructC) + ;;If the older-construct is a "real" ReifiableConstructC and no sub + ;;class the older-construct must be marked as deleted. + ;;Sub classes are marked as deleted in the "next-method" calls. + (mark-as-deleted newer-construct :revision revision)) + older-construct)))) + + +(defmethod merge-constructs ((construct-1 TopicC) (construct-2 TopicC) + &key (revision *TM-REVISION*)) + (declare (integer revision)) + (if (eql construct-1 construct-2) + construct-1 + (let ((older-construct (call-next-method))) + (let ((newer-construct (if (eql older-construct construct-1) + construct-2 + construct-1))) + (dolist (psi (psis newer-construct :revision revision)) + (delete-psi newer-construct psi :revision revision) + (add-psi older-construct psi :revision revision)) + (dolist (locator (locators newer-construct :revision revision)) + (delete-locator newer-construct locator :revision revision) + (add-locator older-construct locator :revision revision)) + ;;occurrences + ;;names + variants + ;;player-in-roles + ;;used-as-type + ;;used-as-scope + ;;reified-construct + ;;in-topicmaps + ))))

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 1 16:31:29 2010 @@ -77,7 +77,6 @@ :test-find-oldest-construct))

-;;TODO: test equivalent-constructs ;;TODO: test merge-constructs