[isidorus-cvs] r141 - in trunk/src: model unit_tests

[Lukas Giessmann]

Author: lgiessmann
Date: Thu Sep 10 06:12:47 2009
New Revision: 141

Log:
datamodel: added a 1:1 elephant-assocation to ReifiableConstructC and TopicC realizing reification; extended the functions delete-construct and initialize-instance of the affected classes

Modified:
   trunk/src/model/datamodel.lisp
   trunk/src/unit_tests/importer_test.lisp

Modified: trunk/src/model/datamodel.lisp
==============================================================================
--- trunk/src/model/datamodel.lisp	(original)
+++ trunk/src/model/datamodel.lisp	Thu Sep 10 06:12:47 2009
@@ -101,6 +101,8 @@
 	   :variants
 	   :xor
            :create-latest-fragment-of-topic
+	   :reified
+	   :reifier
 
            :*current-xtm* ;; special variables
            :*TM-REVISION*
@@ -372,11 +374,11 @@
            (symbol-value '*TM-REVISION*))
           (t 0)))
        (properties (slot-value construct slot-name)))
-                                        ;(format t "revision in filter-slot-value-by-revision is ~a~&" revision)
+       ;(format t "revision in filter-slot-value-by-revision is ~a~&" revision)
     (cond
       ((not properties) 
        nil)   ;if we don't have any properties, we don't have to worry
-                                        ;about revisions
+              ;about revisions
       ((= 0 revision)
        (remove 
         nil
@@ -599,26 +601,45 @@
     :inherit t
     :documentation "Slot that realizes a 1 to N
                      relation between reifiable constructs and their
-                     identifiers; pseudo-initarg is :item-identifiers. Is inherited by all reifiable constructs"))
+                     identifiers; pseudo-initarg is :item-identifiers. Is inherited by all reifiable constructs")
+   (reifier
+    :associate TopicC
+    :inherit t
+    :documentation "Represents a reifier association to a topic, i.e.
+                   it stands for a 1:1 association between this class and TopicC"))
   (:documentation "Reifiable constructs as per TMDM"))
 
+
+(defgeneric reifier (construct &key revision)
+  (:method ((construct ReifiableConstructC) &key (revision *TM-REVISION*))
+    (when (slot-boundp construct 'reifier)
+      (filter-slot-value-by-revision construct 'reifier :start-revision revision))))
+
+(defgeneric (setf reifier) (topic TopicC)
+  (:method (topic (construct ReifiableConstructC))
+    (setf (slot-value construct 'reifier) topic)
+    (setf (reified topic) construct)))
+
 (defgeneric item-identifiers (construct &key revision)
   (:method ((construct ReifiableConstructC) &key (revision *TM-REVISION*))
     (filter-slot-value-by-revision construct 'item-identifiers :start-revision revision)))
 
-(defmethod initialize-instance :around ((instance ReifiableConstructC) &key (item-identifiers nil))
+(defmethod initialize-instance :around ((instance ReifiableConstructC) &key (item-identifiers nil) (reifier nil))
   "adds associations to these ids after the instance was initialized."
   (declare (list item-identifiers))
   (call-next-method)
   (dolist (id item-identifiers)
     (declare (ItemIdentifierC id))
     (setf (identified-construct id) instance))
+  (when reifier
+    (setf (reifier instance) reifier))
   instance)
 
-
 (defmethod delete-construct :before ((construct ReifiableConstructC))
   (dolist (id (item-identifiers construct))
-    (delete-construct id)))
+    (delete-construct id))
+  (when (reifier construct)
+    (slot-makunbound (reifier construct) 'reified)))
 
 (defgeneric item-identifiers-p (constr)
   (:documentation "Test for the existence of item identifiers")
@@ -928,9 +949,23 @@
    (in-topicmaps
     :associate (TopicMapC topics)
     :many-to-many t
-    :documentation "list of all topic maps this topic is part of"))
+    :documentation "list of all topic maps this topic is part of")
+   (reified
+    :associate ReifiableConstructC
+    :documentation "contains a reified object, represented as 1:1 association"))
   (:documentation "Topic in a Topic Map"))
 
+
+(defgeneric reified (topic &key revision)
+  (:method ((topic TopicC) &key (revision *TM-REVISION*))
+    (when (slot-boundp topic 'reified)
+      (filter-slot-value-by-revision topic 'reified :start-revision revision))))
+
+(defgeneric (setf reified) (reifiable ReifiableConstructC)
+  (:method (reifiable (topic TopicC))
+    (setf (slot-value topic 'reified) reifiable)
+    (setf (reifier reifiable) topic)))
+
 (defgeneric occurrences (topic &key revision)
   (:method ((topic TopicC) &key (revision *TM-REVISION*))
     (filter-slot-value-by-revision topic 'occurrences :start-revision revision)))
@@ -966,19 +1001,21 @@
   (:method ((topic TopicC) &key (revision *TM-REVISION*))
     (filter-slot-value-by-revision topic 'in-topicmaps :start-revision revision)))
 
-(defmethod initialize-instance :around ((instance TopicC) &key (psis nil) (locators nil))
+(defmethod initialize-instance :around ((instance TopicC) &key (psis nil) (locators nil) (reified nil))
   "implement the pseudo-initargs :topic-ids, :persistent-ids, and :subject-locators"
   (declare (list psis))
   (declare (list locators))
   (call-next-method)
-                                        ;item-identifiers are handled in the around-method for ReifiableConstructs,
-                                        ;TopicIdentificationCs are handled in make-construct of TopicC
+  ;item-identifiers are handled in the around-method for ReifiableConstructs,
+  ;TopicIdentificationCs are handled in make-construct of TopicC
   (dolist (persistent-id psis)
     (declare (PersistentIdC persistent-id))
     (setf (identified-construct persistent-id) instance))
   (dolist (subject-locator locators)
     (declare (SubjectLocatorC subject-locator))
-    (setf (identified-construct subject-locator) instance)))
+    (setf (identified-construct subject-locator) instance))
+  (when reified
+    (setf (reified instance) reified)))
 
 
 (defmethod delete-construct :before ((construct TopicC))
@@ -993,7 +1030,9 @@
   (dolist (theme (used-as-theme construct))
     (elephant:remove-association construct 'used-as-theme theme))
   (dolist (tm (in-topicmaps construct))
-    (elephant:remove-association construct 'in-topicmaps tm)))
+    (elephant:remove-association construct 'in-topicmaps tm))
+  (when (reified construct)
+    (slot-makunbound (reified construct) 'reifier)))
   
 (defun get-all-constructs-by-uri (uri)
   (delete 

Modified: trunk/src/unit_tests/importer_test.lisp
==============================================================================
--- trunk/src/unit_tests/importer_test.lisp	(original)
+++ trunk/src/unit_tests/importer_test.lisp	Thu Sep 10 06:12:47 2009
@@ -662,6 +662,5 @@
 ;as (importer-test:run-importer-tests)
 (defun run-importer-tests ()
   (run! 'importer-test))
-;or (it.bese.fiveam.run! )