Changeset 219 for branches/new-datamodel

Timestamp:

03/09/10 11:11:24 (15 years ago)

Author:

lgiessmann

Message:

new-datamodel: added delete-construct to TopicC, NameC, OccurrenceC, PersistentIdC, ItemIdentifierC, ReifiableConstructC, SubjectLocatorC, VariantC and all their version-associations

File:

• branches/new-datamodel/src/model/datamodel.lisp (modified) (8 diffs)

branches/new-datamodel/src/model/datamodel.lisp ¶

@@ -764 +764 @@
 
 ;;; 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
@@ -786 +791 @@
 
 
+;;; 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)
@@ -1194 +1287 @@
 
 ;;; 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
@@ -1244 +1344 @@
 
 ;;; 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)
@@ -1473 +1578 @@
 
 ;;; 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
@@ -1588 +1702 @@
 
 ;;; 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
@@ -1633 +1752 @@
 
 ;;; 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
@@ -1691 +1814 @@
 
 ;;; 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.")