Author: lgiessmann Date: Tue Mar 9 06:11:24 2010 New Revision: 219 Log: new-datamodel: added delete-construct to TopicC, NameC, OccurrenceC, PersistentIdC, ItemIdentifierC, ReifiableConstructC, SubjectLocatorC, VariantC and all their version-associations 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 Mar 9 06:11:24 2010 @@ -763,6 +763,11 @@ ;;; PointerC +(defmethod delete-construct :before ((construct PointerC)) + (dolist (p-assoc (slot-p construct 'identified-construct)) + (delete-construct p-assoc))) + + (defgeneric owned-p (construct) (:documentation "Returns t if the passed construct is referenced by a parent TM construct.")) @@ -785,7 +790,95 @@ (first assocs))))) +;;; PointerAssociationC +(defmethod delete-construct :before ((construct PointerAssociationC)) + (delete-1-n-association construct 'identifier)) + + +;;; ItemIdAssociationC +(defmethod delete-construct :before ((construct ItemIdAssociationC)) + (delete-1-n-association construct 'parent-construct)) + + +;;; TopicIdAssociationC +(defmethod delete-construct :before ((construct TopicIdAssociationC)) + (delete-1-n-association construct 'parent-construct)) + + +;;; PersistentIdAssociationC +(defmethod delete-construct :before ((construct PersistentIdAssociationC)) + (delete-1-n-association construct 'parent-construct)) + + +;;; SubjectLocatorAssociationC +(defmethod delete-construct :before ((construct SubjectLocatorAssociationC)) + (delete-1-n-association construct 'parent-construct)) + + +;;; ReifierAssociationC +(defmethod delete-construct :before ((construct ReifierAssociationC)) + (delete-1-n-association construct 'reifiable-construct) + (delete-1-n-association construct 'reifier-topic)) + + +;;; TypeAssociationC +(defmethod delete-construct :before ((construct TypeAssociationC)) + (delete-1-n-association construct 'type-topic) + (delete-1-n-association construct 'typable-construct)) + + +;;; ScopeAssociationC +(defmethod delete-construct :before ((construct ScopeAssociationC)) + (delete-1-n-association construct 'theme-topic) + (delete-1-n-association construct 'scopable-construct)) + + +;;; CharacteristicAssociationC +(defmethod delete-construct :before ((construct CharacteristicAssociationC)) + (delete-1-n-association construct 'charactersitic)) + + +;;; OccurrenceAssociationC +(defmethod delete-construct :before ((construct OccurrenceAssociationC)) + (delete-1-n-association construct 'parent-construct)) + + +;;; NameAssociationC +(defmethod delete-construct :before ((construct NameAssociationC)) + (delete-1-n-association construct 'parent-construct)) + + +;;; VariantAssociationC +(defmethod delete-construct :before ((construct VariantAssociationC)) + (delete-1-n-association construct 'parent-construct)) + + ;;; TopicC +(defmethod delete-construct :before ((construct TopicC)) + (let ((psis-to-delete + (map 'list #'identifier (slot-p construct 'psis))) + (sls-to-delete + (map 'list #'identifier (slot-p construct 'psis))) + (names-to-delete + (map 'list #'characteristic (slot-p construct 'names))) + (occurrences-to-delete (slot-p construct 'occurrences)) + ;TODO: roles -> associations? + (typables-to-delete + (map 'list #'typable-construct (slot-p construct 'used-as-type))) + (reifier-assocs-to-delete (slot-p construct 'reified-construct))) + (dolist (construct-to-delete (append psis-to-delete + sls-to-delete + names-to-delete + occurrences-to-delete + typables-to-delete + reifier-assocs-to-delete)) + (delete-construct construct-to-delete))) + (dolist (scope-assoc-to-delete (slot-p construct 'used-as-theme)) + (delete-construct scope-assoc-to-delete)) + (dolist (tm (slot-p construct 'in-topicmaps)) + (remove-association construct 'in-topicmaps tm))) + + (defmethod owned-p ((construct TopicC)) (when (slot-p construct 'in-topicmaps) t)) @@ -1193,6 +1286,13 @@ ;;; NameC +(defmethod delete-construct :before ((construct NameC)) + (dolist (variant-to-delete + (map 'list #'characteristic + (slot-p construct 'variants))) + (delete-construct variant-to-delete))) + + (defgeneric variants (construct &key revision) (:documentation "Returns all variants that correspond with the given revision and that are associated with the passed construct.") @@ -1243,6 +1343,11 @@ ;;; CharacteristicC +(defmethod delete-construct :before ((construct CharacteristicC)) + (dolist (characteristic-assoc-to-delete (slot-p construct 'parent)) + (delete-construct characteristic-assoc-to-delete))) + + (defmethod owned-p ((construct CharacteristicC)) (when (slot-p construct 'parent) t)) @@ -1472,6 +1577,15 @@ ;;; ReifiableConstructC +(defmethod delete-construct :before ((construct ReifiableConstructC)) + (let ((iis-to-delete + (map 'list #'identifier (slot-p construct 'item-identifiers))) + (reifier-tops-to-delete + (map 'list #'reifier-topic (slot-p construct 'reifier)))) + (dolist (construct-to-delete (append iis-to-delete reifier-tops-to-delete)) + (delete-construct construct-to-delete)))) + + (defgeneric item-identifiers (construct &key revision) (:documentation "Returns the ItemIdentifierC-objects that correspond with the passed construct and the passed version.") @@ -1587,6 +1701,11 @@ ;;; ScopableC +(defmethod delete-construct :before ((construct ScopableC)) + (dolist (scope-assoc-to-delete (slot-p construct 'themes)) + (delete-construct scope-assoc-to-delete))) + + (defgeneric themes (construct &key revision) (:documentation "Returns all topics that correspond with the given revision as a scope for the given topic.") @@ -1632,6 +1751,10 @@ ;;; TypableC +(defmethod delete-construct :before ((construct TypableC)) + (dolist (type-assoc-to-delete (slot-p construct 'instance-of)) + (delete-construct type-assoc-to-delete))) + (defgeneric instance-of (construct &key revision) (:documentation "Returns the type topic that is set on the passed revision.") @@ -1690,6 +1813,13 @@ ;;; TopicMapC +(defmethod delete-construct :before ((construct TopicMapC)) + (dolist (top (slot-p construct 'topics)) + (remove-association construct 'topics top)) + (dolist (assoc (slot-p construct 'associations)) + (remove-association construct 'associations assoc))) + + (defgeneric topics (construct &key revision) (:documentation "Returns all TopicC-objects that are contained in the tm.") (:method ((construct TopicMapC) &key (revision 0))