[isidorus-cvs] r160 - in trunk/src: . unit_tests xml/rdf

Lukas Giessmann lgiessmann at common-lisp.net
Fri Dec 4 15:10:37 UTC 2009


Author: lgiessmann
Date: Fri Dec  4 10:10:36 2009
New Revision: 160

Log:
changed the rdf2tm-mapping when exporting reifiers; fixed some problems in the rdf-reification-test-file

Modified:
   trunk/src/constants.lisp
   trunk/src/isidorus.asd
   trunk/src/unit_tests/reification.rdf
   trunk/src/unit_tests/reification_test.lisp
   trunk/src/unit_tests/unittests-constants.lisp
   trunk/src/xml/rdf/exporter.lisp
   trunk/src/xml/rdf/map_to_tm.lisp
   trunk/src/xml/rdf/rdf_tools.lisp

Modified: trunk/src/constants.lisp
==============================================================================
--- trunk/src/constants.lisp	(original)
+++ trunk/src/constants.lisp	Fri Dec  4 10:10:36 2009
@@ -63,7 +63,7 @@
 	   :*tm2rdf-associationtype-property*
 	   :*tm2rdf-player-property*
 	   :*rdf2tm-blank-node-prefix*
-	   :*tm2rdf-association-reifier-property*))
+	   :*tm2rdf-reifier-property*))
 	   
 
 (in-package :constants)
@@ -173,4 +173,4 @@
 
 (defparameter *tm2rdf-player-property* (concatenate 'string *tm2rdf-ns* "player"))
 
-(defparameter *tm2rdf-association-reifier-property* (concatenate 'string *tm2rdf-ns* "association-reifier"))
+(defparameter *tm2rdf-reifier-property* (concatenate 'string *tm2rdf-ns* "reifier"))

Modified: trunk/src/isidorus.asd
==============================================================================
--- trunk/src/isidorus.asd	(original)
+++ trunk/src/isidorus.asd	Fri Dec  4 10:10:36 2009
@@ -113,7 +113,7 @@
 				     (:static-file "full_mapping.rdf")
 				     (:static-file "reification_xtm1.0.xtm")
 				     (:static-file "reification_xtm2.0.xtm")
-				     (:static-file "reification.xtm")
+				     (:static-file "reification.rdf")
 				     (:file "atom-conf")
 				     (:file "unittests-constants"
 					    :depends-on ("dangling_topicref.xtm"

Modified: trunk/src/unit_tests/reification.rdf
==============================================================================
--- trunk/src/unit_tests/reification.rdf	(original)
+++ trunk/src/unit_tests/reification.rdf	Fri Dec  4 10:10:36 2009
@@ -32,37 +32,40 @@
 
   <!-- reification in Topic-Maps-mapped-RDF -->
   <rdf:Description rdf:about="http://simpsons.tv/lisa">
-    <isi:name rdf:ID="lisa-name">
+    <isi:name>
       <rdf:Description>
 	<rdf:type rdf:resource="http://isidorus/tm2rdf_mapping/types/Name"/>
-	<isi:type rdf:resource="http://simpsons.tv/lastName"/>
+	<isi:nametype rdf:resource="http://simpsons.tv/lastName"/>
 	<isi:value>Simpson</isi:value>
-	<isi:variant rdf:ID="lisa-name-variant">
+	<isi:reifier rdf:resource="lisa-name"/>
+	<isi:variant>
 	  <rdf:Description>
 	    <rdf:type rdf:resource="http://isidorus/tm2rdf_mapping/types/Variant"/>
 	    <isi:scope rdf:resource="http://simpsons.tv/sortName"/>
 	    <isi:value>Lisa Simpson</isi:value>
+	    <isi:reifier rdf:resource="lisa-name-variant"/>
 	  </rdf:Description>
 	</isi:variant>
       </rdf:Description>
     </isi:name>
-    <isi:occurrence rdf:ID="lisa-occurrence">
+    <isi:occurrence>
       <rdf:Description>
-	<rdf:type rdf:resource="http://isidorus/tm2rdf_mapping/Occurrence"/>
-	<isi:type rdf:resource="http://simpsons.tv/profession"/>
+	<isi:reifier rdf:resource="lisa-occurrence"/>
+	<rdf:type rdf:resource="http://isidorus/tm2rdf_mapping/types/Occurrence"/>
+	<isi:occurrencetype rdf:resource="http://simpsons.tv/profession"/>
 	<isi:value>Student</isi:value>
       </rdf:Description>
     </isi:occurrence>
   </rdf:Description>
 
   <!-- reifiers -->
-    <rdf:Description rdf:about="#lisa-name">
+  <rdf:Description rdf:about="lisa-name">
     <arcs:author rdf:resource="http://some.where/me"/>
   </rdf:Description>
-  <rdf:Description rdf:about="#lisa-name-variant">
+  <rdf:Description rdf:about="lisa-name-variant">
     <arcs:author rdf:resource="http://some.where/me"/>
   </rdf:Description>
-  <rdf:Description rdf:about="#lisa-occurrence">
+  <rdf:Description rdf:about="lisa-occurrence">
     <arcs:author rdf:resource="http://some.where/me"/>
   </rdf:Description>
 
@@ -70,26 +73,27 @@
   <!-- reification in Topic-Maps-mapped-RDF (TM-association) -->
   <rdf:Description>
     <rdf:type rdf:resource="http://isidorus/tm2rdf_mapping/types/Association"/>
-    <isi:type rdf:resource="http://simpsons.tv/friendship"/>
-    <isi:association-reifier rdf:resource="friendship-association"/>
-    <isi:role rdf:ID="friend-role">
+    <isi:associationtype rdf:resource="http://simpsons.tv/friendship"/>
+    <isi:reifier rdf:resource="friendship-association"/>
+    <isi:role>
       <rdf:Description>
 	<rdf:type rdf:resource="http://isidorus/tm2rdf_mapping/types/Role"/>
-	<isi:type rdf:resource="http://simpsons.tv/friend"/>
+	<isi:roletype rdf:resource="http://simpsons.tv/friend"/>
 	<isi:player rdf:resource="http://simpsons.tv/Lenny"/>
+	<isi:reifier rdf:resource="friend-role"/>
       </rdf:Description>
     </isi:role>
     <isi:role>
       <rdf:Description>
 	<rdf:type rdf:resource="http://isidorus/tm2rdf_mapping/types/Role"/>
-	<isi:type rdf:resource="http://simpsons.tv/friend"/>
+	<isi:roletype rdf:resource="http://simpsons.tv/friend"/>
 	<isi:player rdf:resource="http://simpsons.tv/Carl"/>
       </rdf:Description>
     </isi:role>
   </rdf:Description>
 
   <!-- reifiers -->
-  <rdf:Description rdf:about="#friend-role">
+  <rdf:Description rdf:about="friend-role">
     <arcs:author rdf:resource="http://some.where/me"/>
   </rdf:Description>
   <rdf:Description rdf:about="friendship-association">

Modified: trunk/src/unit_tests/reification_test.lisp
==============================================================================
--- trunk/src/unit_tests/reification_test.lisp	(original)
+++ trunk/src/unit_tests/reification_test.lisp	Fri Dec  4 10:10:36 2009
@@ -37,7 +37,8 @@
    :test-xtm2.0-reification
    :test-xtm1.0-reification-exporter
    :test-xtm2.0-reification-exporter
-   :test-rdf-importer-reification))
+   :test-rdf-importer-reification
+   :test-rdf-importer-reification-2))
 
 
 (in-package :reification-test)
@@ -626,12 +627,27 @@
   (elephant:close-store))
 
 
+(test test-rdf-importer-reification-2
+  "Tests the rdf-importer, especially some reification cases of
+   the tm2rdf mapping."
+  (let ((db-dir "data_base")
+	(tm-id "http://test-tm/")
+	(revision-1 100)
+	(document-id "doc-id"))
+    (rdf-importer:rdf-importer
+     *reification.rdf* db-dir :tm-id tm-id
+     :document-id document-id :start-revision revision-1)
+
+    ))
+
+
 
 ;;TODO: check rdf exporter
 ;;TODO: check rdf-tm-reification-mapping
 ;;TODO: check merge-reifier-topics (--> versioning)
 ;;TODO: check fragment exporter
 ;;TODO: extend the fragment-importer in the RESTful-interface
+;;TODO: DOKU
 
 
 (defun run-reification-tests ()
@@ -640,4 +656,5 @@
   (it.bese.fiveam:run! 'test-xtm2.0-reification)
   (it.bese.fiveam:run! 'test-xtm1.0-reification-exporter)
   (it.bese.fiveam:run! 'test-xtm2.0-reification-exporter)
-  (it.bese.fiveam:run! 'test-rdf-importer-reification))
\ No newline at end of file
+  (it.bese.fiveam:run! 'test-rdf-importer-reification)
+  (it.bese.fiveam:run! 'test-rdf-importer-reification-2))
\ No newline at end of file

Modified: trunk/src/unit_tests/unittests-constants.lisp
==============================================================================
--- trunk/src/unit_tests/unittests-constants.lisp	(original)
+++ trunk/src/unit_tests/unittests-constants.lisp	Fri Dec  4 10:10:36 2009
@@ -33,7 +33,8 @@
 	   :*poems_light.xtm*
 	   :*full_mapping.rdf*
 	   :*reification_xtm1.0.xtm*
-	   :*reification_xtm2.0.xtm*))
+	   :*reification_xtm2.0.xtm*
+	   :*reification.rdf*))
 
 (in-package :unittests-constants)
 
@@ -113,4 +114,8 @@
 
 (defparameter *reification_xtm2.0.xtm*
   (asdf:component-pathname
-   (asdf:find-component *unit-tests-component* "reification_xtm2.0.xtm")))
\ No newline at end of file
+   (asdf:find-component *unit-tests-component* "reification_xtm2.0.xtm")))
+
+(defparameter *reification.rdf*
+  (asdf:component-pathname
+   (asdf:find-component *unit-tests-component* "reification.rdf")))

Modified: trunk/src/xml/rdf/exporter.lisp
==============================================================================
--- trunk/src/xml/rdf/exporter.lisp	(original)
+++ trunk/src/xml/rdf/exporter.lisp	Fri Dec  4 10:10:36 2009
@@ -27,7 +27,7 @@
 		*tm2rdf-topic-type-uri*
 		*tm2rdf-association-type-uri*
 		*tm2rdf-role-type-uri*
-		*tm2rdf-association-reifier-property*)
+		*tm2rdf-reifier-property*)
   (:import-from :isidorus-threading
 		with-reader-lock
 		with-writer-lock)
@@ -213,7 +213,11 @@
    or rdf:nodeID, this depends on the PSIS of the topic."
   (declare (TopicC topic))
   (if (psis topic)
-      (cxml:attribute "rdf:resource" (uri (first (psis topic))))
+      (cxml:attribute "rdf:resource"
+		      (let ((psi (get-reifier-psi topic)))
+			(if psi
+			    (concatenate 'string "#" (get-reifier-uri topic))
+			    (uri (first (psis topic))))))
       (cxml:attribute "rdf:nodeID" (make-object-id topic))))
 
 
@@ -280,13 +284,10 @@
   "Creates a blank node that represents a VariantC element with the
    properties itemIdentity, scope and value."
   (cxml:with-element "isi:variant"
-    (when (reifier construct)
-      (let ((reifier-uri (get-reifier-uri (reifier construct))))
-	(when reifier-uri
-	  (cxml:attribute "rdf:ID" reifier-uri))))
     (cxml:with-element "rdf:Description"
       (cxml:attribute "rdf:nodeID" (make-object-id construct))
       (make-isi-type *tm2rdf-variant-type-uri*)
+      (export-reifier-as-mapping construct)
       (map 'list #'to-rdf-elem (item-identifiers construct))
       (scopes-to-rdf-elems construct)
       (resourceX-to-rdf-elem construct))))
@@ -296,13 +297,10 @@
   "Creates a blank node that represents a name element with the
    properties itemIdentity, nametype, value, variant and scope."
   (cxml:with-element "isi:name"
-    (when (reifier construct)
-      (let ((reifier-uri (get-reifier-uri (reifier construct))))
-	(when reifier-uri
-	  (cxml:attribute "rdf:ID" reifier-uri))))
     (cxml:with-element "rdf:Description"
       (cxml:attribute "rdf:nodeID" (make-object-id construct))
       (make-isi-type *tm2rdf-name-type-uri*)
+      (export-reifier-as-mapping construct)
       (map 'list #'to-rdf-elem (item-identifiers construct))
       (when (slot-boundp construct 'instance-of)
 	(cxml:with-element "isi:nametype"
@@ -326,13 +324,10 @@
 	    (item-identifiers construct)
 	    (/= (length (psis (instance-of construct))) 1))
 	(cxml:with-element "isi:occurrence"
-	  (when (reifier construct)
-	    (let ((reifier-uri (get-reifier-uri (reifier construct))))
-	      (when reifier-uri
-		(cxml:attribute "rdf:ID" reifier-uri))))
 	  (cxml:with-element "rdf:Description"
 	    (cxml:attribute "rdf:nodeID" (make-object-id construct))
 	    (make-isi-type *tm2rdf-occurrence-type-uri*)
+	    (export-reifier-as-mapping construct)
 	    (map 'list #'to-rdf-elem (item-identifiers construct))
 	    (cxml:with-element "isi:occurrencetype"
 	      (make-topic-reference (instance-of construct)))
@@ -340,6 +335,7 @@
 	    (resourceX-to-rdf-elem construct)))
 	(with-property construct
 	  (cxml:attribute "rdf:datatype" (datatype construct))
+	  (export-reifier construct)
 	  (when (themes construct)
 	    (cxml:attribute "xml:lang" (get-xml-lang
 					(first (themes construct)))))
@@ -442,9 +438,7 @@
     (cxml:with-element "rdf:Description" 
       (cxml:attribute "rdf:nodeID" (make-object-id association))
       (make-isi-type *tm2rdf-association-type-uri*)
-      (when (reifier association)
-	(cxml:with-element *tm2rdf-association-reifier-property*
-	  (make-topic-reference (reifier association))))
+      (export-reifier-as-mapping association)
       (cxml:with-element "isi:associationtype"
 	(make-topic-reference association-type))
       (map 'list #'to-rdf-elem ii)
@@ -461,9 +455,7 @@
     (cxml:with-element "isi:role"
       (cxml:with-element "rdf:Description"
 	(cxml:attribute "rdf:nodeID" (make-object-id construct))
-        (when (reifier construct)
-	  (cxml:with-element *tm2rdf-association-reifier-property*
-	    (make-topic-reference (reifier construct))))
+	(export-reifier-as-mapping construct)
 	(make-isi-type *tm2rdf-role-type-uri*)
 	(map 'list #'to-rdf-elem ii)
 	(cxml:with-element "isi:roletype"
@@ -491,10 +483,7 @@
       (when (and subject-role object-role
 		 (= (length association-roles) 2))
 	(with-property association
-	  (when (reifier association)
-	    (let ((reifier-uri (get-reifier-uri (reifier association))))
-	      (when reifier-uri
-		(cxml:attribute "rdf:ID" reifier-uri))))
+	  (export-reifier association)
 	  (make-topic-reference (player object-role)))))))
 
 
@@ -556,6 +545,18 @@
 	  (cxml:attribute "rdf:ID" reifier-uri))))))
 
 
+(defun export-reifier-as-mapping (reifiable-construct)
+  "Exports the reifier as isi:reifier property."
+  (declare (ReifiableConstructC reifiable-construct))
+  (let ((reifier-topic (reifier reifiable-construct)))
+    (when (and reifier-topic
+	       (psis reifier-topic))
+      (let ((reifier-uri (get-reifier-uri reifier-topic)))
+	(when reifier-uri
+	  (cxml:with-element *tm2rdf-reifier-property*
+	    (cxml:attribute "rdf:resource" reifier-uri)))))))
+
+
 (defun get-reifier-uri (top)
   "Returns the uri that represents the reifier-id of a resource node.
    When the topic does not own a psi the return value is nil."

Modified: trunk/src/xml/rdf/map_to_tm.lisp
==============================================================================
--- trunk/src/xml/rdf/map_to_tm.lisp	(original)
+++ trunk/src/xml/rdf/map_to_tm.lisp	Fri Dec  4 10:10:36 2009
@@ -105,14 +105,14 @@
 	 (get-associations-by-type assoc-top start-revision 
 				   *tm2rdf-role-property*
 				   *rdf2tm-subject*)))
-    (let ((players-and-reifiers
-	   (get-players-and-reifiers-by-role-type
+    (let ((players
+	   (get-players-by-role-type
 	    role-assocs start-revision *rdf2tm-object*))) 
       (map 'list #'d::delete-construct role-assocs)
-      players-and-reifiers)))
+      players)))
 
 
-(defun map-isi-role(role-top reifier-topic start-revision)
+(defun map-isi-role(role-top start-revision)
   "Maps a passed topic with all its isidorus:types to a
    property list representing an association-role."
   (declare (TopicC role-top))
@@ -130,7 +130,8 @@
     (let ((types (get-players-by-role-type
 		  type-assocs start-revision *rdf2tm-object*))
 	  (role-players (get-players-by-role-type
-			 player-assocs start-revision *rdf2tm-object*)))
+			 player-assocs start-revision *rdf2tm-object*))
+	  (reifiers (get-isi-reifiers role-top start-revision)))
       (elephant:ensure-transaction  (:txn-nosync t)
 	(map 'list #'d::delete-construct type-assocs)
 	(map 'list #'d::delete-construct player-assocs)
@@ -145,7 +146,7 @@
 	(list :instance-of (first types)
 	      :player (first role-players)
 	      :item-identifiers ids
-	      :reifier reifier-topic)))))
+	      :reifiers reifiers)))))
 
 
 (defun map-isi-association(assoc-top start-revision tm-id
@@ -160,28 +161,21 @@
 	 (get-associations-by-type
 	  assoc-top start-revision *tm2rdf-associationtype-property*
 	  *rdf2tm-subject*))
-	(reifier-assocs
-	 (get-associations-by-type
-	  assoc-top start-revision *tm2rdf-association-reifier-property*
-	  *rdf2tm-subject*))
 	(scope-assocs
 	 (get-associations-by-type
 	  assoc-top start-revision *tm2rdf-scope-property*
 	  *rdf2tm-subject*))
-	(role-and-reifier-topics (get-isi-roles assoc-top start-revision)))
+	(role-topics (get-isi-roles assoc-top start-revision)))
     (let ((types (get-players-by-role-type
 		  type-assocs start-revision *rdf2tm-object*))
 	  (scopes (get-players-by-role-type
 		   scope-assocs start-revision *rdf2tm-object*))
-	  (reifier-topics (get-players-by-role-type
-			   reifier-assocs start-revision  *rdf2tm-object*))
+	  (reifier-topics (get-isi-reifiers assoc-top start-revision))
 	  (assoc-roles 
 	   (remove-if #'null (map 'list 
-				  #'(lambda(role-and-reifier)
-				      (map-isi-role (getf role-and-reifier :player)
-						    (getf role-and-reifier :reifier)
-						    start-revision))
-				  role-and-reifier-topics))))
+				  #'(lambda(role-topic)
+				      (map-isi-role role-topic start-revision))
+				  role-topics))))
       (elephant:ensure-transaction  (:txn-nosync t)
 	(map 'list #'d::delete-construct type-assocs)
 	(map 'list #'d::delete-construct scope-assocs)
@@ -210,13 +204,14 @@
 							  (getf list-item :instance-of))
 						     (eql (player association-role)
 							  (getf list-item :player))
-						     (getf list-item :reifier)))
+						     (getf list-item :reifiers)))
 					    assoc-roles)))
 			      (when found-item
-				(add-reifier association-role (getf found-item :reifier)))))
+				(dolist (reifier-topic (getf found-item :reifiers))
+				  (add-reifier association-role reifier-topic)))))
 		  (roles association))
-	     (when reifier-topics
-	       (add-reifier association (first reifier-topics)))
+	     (dolist (reifier-topic reifier-topics)
+	       (add-reifier association reifier-topic))
 	     association)))))))
 
 
@@ -232,21 +227,17 @@
 		       top start-revision
 		       :id-type-uri *tm2rdf-subjectlocator-property*))
 	(new-item-ids (map-isi-identifiers top start-revision))
-	(occurrence-and-reifier-topics (get-isi-occurrences top start-revision))
-	(name-and-reifier-topics (get-isi-names top start-revision)))
+	(occurrence-topics (get-isi-occurrences top start-revision))
+	(name-topics (get-isi-names top start-revision)))
     (bound-subject-identifiers top new-psis)
     (bound-subject-locators top new-locators)
     (bound-item-identifiers top new-item-ids)
-    (map 'list #'(lambda(occurrence-and-reifier)
-		   (map-isi-occurrence top (getf occurrence-and-reifier :player)
-				       (getf occurrence-and-reifier :reifier)
-				       start-revision))
-	 occurrence-and-reifier-topics)
-    (map 'list #'(lambda(name-and-reifier)
-		   (map-isi-name top (getf name-and-reifier :player)
-				 (getf name-and-reifier :reifier)
-				 start-revision))
-	 name-and-reifier-topics))
+    (map 'list #'(lambda(occurrence-topic)
+		   (map-isi-occurrence top occurrence-topic start-revision))
+	 occurrence-topics)
+    (map 'list #'(lambda(name-topic)
+		   (map-isi-name top name-topic start-revision))
+	 name-topics))
   top)
 
 
@@ -258,14 +249,14 @@
 	 (get-associations-by-type name-top start-revision 
 				   *tm2rdf-variant-property*
 				   *rdf2tm-subject*)))
-    (let ((players-and-reifiers
-	   (get-players-and-reifiers-by-role-type
+    (let ((players
+	   (get-players-by-role-type
 	    variant-assocs start-revision *rdf2tm-object*)))
       (map 'list #'d::delete-construct variant-assocs)
-      players-and-reifiers)))
+      players)))
 
 
-(defun map-isi-variant (name variant-top reifier-topic start-revision)
+(defun map-isi-variant (name variant-top start-revision)
   "Maps the passed variant-topic to a TM variant."
   (declare (TopicC variant-top))
   (declare (NameC name))
@@ -288,7 +279,8 @@
 		 (list :value (charvalue value-occ)
 		       :datatype (datatype value-occ))
 		 (list :value ""
-		       :datatype *xml-string*)))))
+		       :datatype *xml-string*))))
+	  (reifiers (get-isi-reifiers variant-top start-revision)))
       (elephant:ensure-transaction  (:txn-nosync t)
 	(map 'list #'d::delete-construct scope-assocs)
 	(delete-related-associations variant-top)
@@ -301,11 +293,12 @@
 			       :charvalue (getf value-and-datatype :value)
 			       :datatype (getf value-and-datatype :datatype)
 			       :name name)))
-	  (add-reifier variant reifier-topic)
+	  (dolist (reifier-topic reifiers)
+	    (add-reifier variant reifier-topic))
 	  variant)))))
 
 
-(defun map-isi-name (top name-top reifier-topic start-revision)
+(defun map-isi-name (top name-top start-revision)
   "Maps the passed occurrence-topic to a TM occurrence."
   (declare (TopicC top name-top))
   (declare (integer start-revision))
@@ -320,7 +313,7 @@
 	  *rdf2tm-subject*))
 	(value-type-topic 
 	 (get-item-by-psi *tm2rdf-value-property*))
-	(variant-and-reifier-topics (get-isi-variants name-top start-revision)))
+	(variant-topics (get-isi-variants name-top start-revision)))
     (let ((type (let ((fn-types
 			(get-players-by-role-type
 			 type-assocs start-revision *rdf2tm-object*)))
@@ -335,7 +328,8 @@
 			   (occurrences name-top))))
 	     (if value-occ
 		 (charvalue value-occ)
-		 ""))))
+		 "")))
+	  (reifiers (get-isi-reifiers name-top start-revision)))
       (elephant:ensure-transaction  (:txn-nosync t)
 	(map 'list #'d::delete-construct type-assocs)
 	(map 'list #'d::delete-construct scope-assocs)
@@ -346,14 +340,14 @@
 				    :instance-of type
 				    :item-identifiers ids
 				    :themes scopes)))
-	  (add-reifier name reifier-topic)
-	  (map 'list #'(lambda(variant-and-reifier)
-			 (map-isi-variant name (getf variant-and-reifier :player)
-					  (getf variant-and-reifier :reifier)
+	  (map 'list #'(lambda(variant-topic)
+			 (map-isi-variant name variant-topic
 					  start-revision))
-	       variant-and-reifier-topics)
+	       variant-topics)
 	  (delete-related-associations name-top)
 	  (d::delete-construct name-top)
+	  (dolist (reifier-topic reifiers)
+	    (add-reifier name reifier-topic))
 	  name)))))
 
 
@@ -364,14 +358,14 @@
   (let ((assocs (get-associations-by-type
 		 top start-revision *tm2rdf-name-property*
 		 *rdf2tm-subject*)))
-    (let ((name-and-reifier-topics
-	   (get-players-and-reifiers-by-role-type
+    (let ((name-topics
+	   (get-players-by-role-type
 	    assocs start-revision *rdf2tm-object*)))
       (map 'list #'d::delete-construct assocs)
-      name-and-reifier-topics)))
+      name-topics)))
 
 
-(defun map-isi-occurrence(top occ-top reifier-topic start-revision)
+(defun map-isi-occurrence(top occ-top start-revision)
   "Maps all topics that represents occurrences of the passed topic top
    to occurrence objects."
   (declare (TopicC top occ-top))
@@ -401,7 +395,8 @@
 		 (list :value (charvalue value-occ)
 		       :datatype (datatype value-occ))
 		 (list :value ""
-		       :datatype *xml-string*)))))
+		       :datatype *xml-string*))))
+	  (reifiers (get-isi-reifiers occ-top start-revision)))
       (elephant:ensure-transaction  (:txn-nosync t)
 	(map 'list #'d::delete-construct type-assocs)
 	(map 'list #'d::delete-construct scope-assocs)
@@ -419,7 +414,8 @@
 			       :instance-of (first types)
 			       :charvalue (getf value-and-datatype :value)
 			       :datatype (getf value-and-datatype :datatype))))
-	  (add-reifier occurrence reifier-topic)
+	  (dolist (reifier-topic reifiers)
+	    (add-reifier occurrence reifier-topic))
 	  occurrence)))))
 
 
@@ -430,11 +426,11 @@
   (let ((assocs (get-associations-by-type
 		 top start-revision *tm2rdf-occurrence-property*
 		 *rdf2tm-subject*)))
-    (let ((occurrences-and-reifiers
-	   (get-players-and-reifiers-by-role-type
+    (let ((occurrence-topics
+	   (get-players-by-role-type
 	    assocs start-revision *rdf2tm-object*)))
       (map 'list #'d::delete-construct assocs)
-      occurrences-and-reifiers)))
+      occurrence-topics)))
 
 
 (defun get-isi-topics (tm-id start-revision
@@ -510,31 +506,6 @@
       players)))
 
 
-(defun get-players-and-reifiers-by-role-type (associations start-revision
-					     role-type-psi)
-  "Returns tuples of the form (:player <player> :reifier <reifier>)"
-    (declare (list associations))
-  (declare (integer start-revision))
-  (declare (string role-type-psi))
-  (let ((role-type (get-item-by-psi role-type-psi
-				    :revision start-revision)))
-    (let ((tuples
-	   (remove-if
-	    #'null
-	    (map 'list
-		 #'(lambda(assoc)
-		     (let ((role 
-			    (find-if #'(lambda(role)
-					 (eql role-type (instance-of role)))
-				     (roles assoc))))
-		       (when role
-			 (let ((reifier-topic (reifier assoc)))
-			   (list :player (player role)
-				 :reifier reifier-topic)))))
-		 associations))))
-      tuples)))
-  
-
 (defun get-occurrences-by-type (top start-revision
 			       &key (occurrence-type-uri
 				     *tm2rdf-itemIdentity-property*))
@@ -626,3 +597,16 @@
 	(d::delete-construct id)
 	(setf (identified-construct id) top)))
   top)
+
+
+(defun get-isi-reifiers (construct start-revision)
+  "Returns all reifiers from the passed construct."
+  (declare (TopicC construct))
+  (let ((reifier-assocs
+	 (get-associations-by-type
+	  construct start-revision *tm2rdf-reifier-property*
+	  *rdf2tm-subject*)))
+    (let ((reifiers
+	   (get-players-by-role-type
+	    reifier-assocs start-revision *rdf2tm-object*)))
+      reifiers)))
\ No newline at end of file

Modified: trunk/src/xml/rdf/rdf_tools.lisp
==============================================================================
--- trunk/src/xml/rdf/rdf_tools.lisp	(original)
+++ trunk/src/xml/rdf/rdf_tools.lisp	Fri Dec  4 10:10:36 2009
@@ -55,7 +55,7 @@
 		*tm2rdf-player-property*
 		*tm2rdf-associationtype-property*
 		*rdf2tm-blank-node-prefix*
-		*tm2rdf-association-reifier-property*)
+		*tm2rdf-reifier-property*)
   (:import-from :xml-constants
 		*rdf_core_psis.xtm*
 		*core_psis.xtm*)




More information about the Isidorus-cvs mailing list