[isidorus-cvs] r219 - branches/new-datamodel/src/model

[Lukas Giessmann]

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))