[isidorus-cvs] r151 - in trunk/src: model unit_tests xml/xtm

[Lukas Giessmann]

Author: lgiessmann
Date: Wed Nov 25 03:39:26 2009
New Revision: 151

Log:
restructured some functions of the importer which are responsible for reifcation; adapted the corresponding unit-tests

Modified:
   trunk/src/model/datamodel.lisp
   trunk/src/unit_tests/reification_test.lisp
   trunk/src/xml/xtm/importer_xtm1.0.lisp
   trunk/src/xml/xtm/importer_xtm2.0.lisp

Modified: trunk/src/model/datamodel.lisp
==============================================================================
--- trunk/src/model/datamodel.lisp	(original)
+++ trunk/src/model/datamodel.lisp	Wed Nov 25 03:39:26 2009
@@ -1585,40 +1585,30 @@
 ;;;;;;;;;;;;;;;;;
 ;; reification
 
-(defgeneric add-reifier (construct reifier-uri &key xtm-version)
-  (:method ((construct ReifiableConstructC) reifier-uri &key (xtm-version '2.0))
+(defgeneric add-reifier (construct reifier-topic)
+  (:method ((construct ReifiableConstructC) reifier-topic)
     (let ((err "From add-reifier(): "))
-      (let ((identifier
-	     (elephant:get-instance-by-value (if (eql xtm-version '1.0)
-						 'PersistentIdC
-						 'ItemIdentifierC) 'uri reifier-uri)))
-	(unless identifier
-	  (when (eql xtm-version '2.0)
-	    (error "~ano identifier could be found with the uri ~a"
-		   err reifier-uri)))
-	(when identifier
-	  (let ((reifier-topic (identified-construct identifier)))
-	    (unless (typep reifier-topic 'TopicC)
-	      (error "~anidentifier ~a must be bound to a topic, but is ~a"
-		     err reifier-uri (type-of reifier-topic)))
-	    (cond
-	      ((and (not (reifier construct))
-		    (not (reified reifier-topic)))
-	       (setf (reifier construct) reifier-topic)
-	       (setf (reified reifier-topic) construct))
-	      ((and (not (reified reifier-topic))
-		    (reifier construct))
-	       (merge-reifier-topics (reifier construct) reifier-topic))
-	      ((and (not (reifier construct))
-		    (reified reifier-topic))
-	       (error "~a~a reifies already another object ~a"
-		      err reifier-uri (reified reifier-topic)))
-	      (t
-	       (when (not (eql (reified reifier-topic) construct))
-		 (error "~a~a reifies already another object ~a"
-			err reifier-uri (reified reifier-topic)))
-	       (merge-reifier-topics (reifier construct) reifier-topic)))))))
-    construct))
+      (declare (TopicC reifier-topic))
+      (cond
+	((and (not (reifier construct))
+	      (not (reified reifier-topic)))
+	 (setf (reifier construct) reifier-topic)
+	 (setf (reified reifier-topic) construct))
+	((and (not (reified reifier-topic))
+	      (reifier construct))
+	 (merge-reifier-topics (reifier construct) reifier-topic))
+	((and (not (reifier construct))
+	      (reified reifier-topic))
+	 (error "~a~a ~a reifies already another object ~a"
+		err (psis reifier-topic) (item-identifiers reifier-topic)
+		(reified reifier-topic)))
+	(t
+	 (when (not (eql (reified reifier-topic) construct))
+	   (error "~a~a ~a reifies already another object ~a"
+		  err (psis reifier-topic) (item-identifiers reifier-topic)
+		  (reified reifier-topic)))
+	 (merge-reifier-topics (reifier construct) reifier-topic)))
+      construct)))
 
 
 (defgeneric merge-reifier-topics (old-topic new-topic)

Modified: trunk/src/unit_tests/reification_test.lisp
==============================================================================
--- trunk/src/unit_tests/reification_test.lisp	(original)
+++ trunk/src/unit_tests/reification_test.lisp	Wed Nov 25 03:39:26 2009
@@ -353,6 +353,7 @@
 ;;TODO: check xtm2.0 exporter
 ;;TODO: check fragment exporter
 ;;TODO: check merge-reifier-topics (--> versioning)
+;;TODO: extend the fragment-importer in the RESTful-interface
 
 
 (defun run-reification-tests ()

Modified: trunk/src/xml/xtm/importer_xtm1.0.lisp
==============================================================================
--- trunk/src/xml/xtm/importer_xtm1.0.lisp	(original)
+++ trunk/src/xml/xtm/importer_xtm1.0.lisp	Wed Nov 25 03:39:26 2009
@@ -18,8 +18,14 @@
 	   (dom:node-value (dom:get-attribute-node reifiable-elem "id")))))
     (when (and (stringp reifier-uri)
 	       (> (length reifier-uri) 0))
-      (add-reifier reifiable-construct (concatenate 'string "#" reifier-uri) :xtm-version '1.0))
-    reifiable-construct))
+      (let ((psi
+	     (elephant:get-instance-by-value 'd:PersistentIdC 'd:uri
+					     (concatenate 'string "#" reifier-uri))))
+	(when psi
+	  (let ((reifier-topic (identified-construct psi)))
+	    (when reifier-topic
+	      (add-reifier reifiable-construct reifier-topic)))))))
+  reifiable-construct)
 
 
 (defun get-topic-id-xtm1.0 (topic-elem)
@@ -408,7 +414,6 @@
                           (from-member-elem-xtm1.0 
                            member-elem :xtm-id xtm-id))
                       (xpath-child-elems-by-qname assoc-elem *xtm1.0-ns* "member"))))
-      ;(format t "type: ~A~%themes: ~A~%roles: ~A~%~%" type themes roles)
       (unless roles
 	(error "from-association-elem-xtm1.0: roles are missing in association"))
       (setf roles (set-standard-role-types roles))
@@ -430,7 +435,16 @@
 						 (eql (player assoc-role)
 						      (getf list-role :player))
 						 (getf list-role :reifier-uri))
-					(add-reifier assoc-role (getf list-role :reifier-uri) :xtm-version '1.0)))
+					(let ((reifier-uri (getf list-role :reifier-uri)))
+					  (when (and (stringp reifier-uri)
+						     (> (length reifier-uri) 0))
+					    (let ((psi
+						   (elephant:get-instance-by-value 'd:PersistentIdC 'd:uri
+										   reifier-uri)))
+					      (when psi
+						(let ((reifier-topic (identified-construct psi)))
+						  (when reifier-topic
+						    (add-reifier assoc-role reifier-topic)))))))))
 			    roles))
 	     (roles association))
 	association))))

Modified: trunk/src/xml/xtm/importer_xtm2.0.lisp
==============================================================================
--- trunk/src/xml/xtm/importer_xtm2.0.lisp	(original)
+++ trunk/src/xml/xtm/importer_xtm2.0.lisp	Wed Nov 25 03:39:26 2009
@@ -13,11 +13,19 @@
   "Sets the reifier-topic of the passed elem to the passed construct."
   (declare (dom:element reifiable-elem))
   (declare (ReifiableConstructC reifiable-construct))
-  (let ((reifier-uri (get-attribute reifiable-elem "reifier")))
+  (let ((reifier-uri (get-attribute reifiable-elem "reifier"))
+	(err "From set-reifier(): "))
     (when (and (stringp reifier-uri)
 	       (> (length reifier-uri) 0))
-      (add-reifier reifiable-construct reifier-uri :xtm-version '2.0))
-    reifiable-construct))
+      (let ((ii
+	     (elephant:get-instance-by-value 'd:ItemIdentifierC 'd:uri reifier-uri)))
+	(if ii
+	    (let ((reifier-topic (identified-construct ii)))
+	      (if reifier-topic
+		  (add-reifier reifiable-construct reifier-topic)
+		  (error "~aitem-identifier ~a not found" err reifier-uri)))
+	    (error "~aitem-identifier ~a not found" err reifier-uri)))))
+    reifiable-construct)
 
 
 (defun from-identifier-elem (classsymbol elem start-revision)
@@ -367,7 +375,8 @@
   (declare (TopicMapC tm))
   (elephant:ensure-transaction (:txn-nosync t) 
     (let 
-        ((item-identifiers 
+        ((err "From from-association-elem(): ")
+	 (item-identifiers 
           (make-identifiers 'ItemIdentifierC assoc-elem "itemIdentity" start-revision))
          (instance-of
           (from-type-elem 
@@ -403,7 +412,18 @@
 						 (eql (player assoc-role)
 						      (getf list-role :player))
 						 (getf list-role :reifier-uri))
-					(add-reifier assoc-role (getf list-role :reifier-uri) :xtm-version '2.0)))
+					(let ((reifier-uri (getf list-role :reifier-uri)))
+					  (when (and (stringp reifier-uri)
+						     (> (length reifier-uri) 0))
+					    (let ((ii
+						   (elephant:get-instance-by-value 'd:ItemIdentifierC 'd:uri
+										   reifier-uri)))
+					      (if ii
+						(let ((reifier-topic (identified-construct ii)))
+						  (if reifier-topic
+						      (add-reifier assoc-role reifier-topic)
+						      (error "~aitem-identifier ~a not found" err reifier-uri)))
+						(error "~aitem-identifier ~a not found" err reifier-uri)))))))
 			    roles))
 	     (roles assoc))
 	(set-reifier assoc-elem assoc)))))