[isidorus-cvs] r155 - in trunk/src: model unit_tests xml/rdf

[Lukas Giessmann]

Author: lgiessmann
Date: Tue Dec  1 06:05:46 2009
New Revision: 155

Log:
added the support of reification to the rdf-exporter

Modified:
   trunk/src/model/datamodel.lisp
   trunk/src/unit_tests/reification_test.lisp
   trunk/src/xml/rdf/exporter.lisp
   trunk/src/xml/rdf/map_to_tm.lisp

Modified: trunk/src/model/datamodel.lisp
==============================================================================
--- trunk/src/model/datamodel.lisp	(original)
+++ trunk/src/model/datamodel.lisp	Tue Dec  1 06:05:46 2009
@@ -104,6 +104,7 @@
 	   :reified
 	   :reifier
 	   :add-reifier
+	   :remove-reifier
 
            :*current-xtm* ;; special variables
            :*TM-REVISION*
@@ -1611,6 +1612,14 @@
       construct)))
 
 
+(defgeneric remove-reifier (construct)
+  (:method ((construct ReifiableConstructC))
+    (let ((reifier-topic (reifier construct)))
+      (when reifier-topic
+	(elephant:remove-association construct 'reifier reifier-topic)
+	(elephant:remove-association reifier-topic 'reified construct)))))
+
+
 (defgeneric merge-reifier-topics (old-topic new-topic)
   ;;the reifier topics are not only merged but also bound to the reified-construct
   (:method ((old-topic TopicC) (new-topic TopicC))

Modified: trunk/src/unit_tests/reification_test.lisp
==============================================================================
--- trunk/src/unit_tests/reification_test.lisp	(original)
+++ trunk/src/unit_tests/reification_test.lisp	Tue Dec  1 06:05:46 2009
@@ -627,7 +627,6 @@
 
 
 
-;;TODO: check rdf importer
 ;;TODO: check rdf exporter
 ;;TODO: check rdf-tm-reification-mapping
 ;;TODO: check merge-reifier-topics (--> versioning)

Modified: trunk/src/xml/rdf/exporter.lisp
==============================================================================
--- trunk/src/xml/rdf/exporter.lisp	(original)
+++ trunk/src/xml/rdf/exporter.lisp	Tue Dec  1 06:05:46 2009
@@ -279,9 +279,12 @@
   "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))
-      ;(cxml:attribute "rdf:parseType" "Resource")
       (make-isi-type *tm2rdf-variant-type-uri*)
       (map 'list #'to-rdf-elem (item-identifiers construct))
       (scopes-to-rdf-elems construct)
@@ -292,7 +295,10 @@
   "Creates a blank node that represents a name element with the
    properties itemIdentity, nametype, value, variant and scope."
   (cxml:with-element "isi:name"
-    ;(cxml:attribute "rdf:parseType" "Resource")
+    (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*)
@@ -319,9 +325,12 @@
 	    (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))
-  	    ;(cxml:attribute "rdf:parseType" "Resource")
 	    (make-isi-type *tm2rdf-occurrence-type-uri*)
 	    (map 'list #'to-rdf-elem (item-identifiers construct))
 	    (cxml:with-element "isi:occurrencetype"
@@ -345,7 +354,8 @@
 		    (occurrences construct)))
 	   (or (used-as-type construct)
 	       (used-as-theme construct)
-	       (xml-lang-p construct)))
+	       (xml-lang-p construct)
+	       (reified construct)))
       nil ;; do not export this topic explicitly, since it has been exported as
           ;; rdf:resource, property or any other reference
       (cxml:with-element "rdf:Description"
@@ -357,7 +367,12 @@
 	      (t-occs (occurrences construct))
 	      (t-assocs (list-rdf-mapped-associations construct)))
 	  (if psi
-	      (cxml:attribute "rdf:about" (uri psi))
+	      (if (reified construct)
+		  (let ((reifier-uri (get-reifier-uri construct)))
+		    (if reifier-uri
+			(concatenate 'string "#" (get-reifier-uri construct))
+			(cxml:attribute "rdf:about" (uri psi))))
+		  (cxml:attribute "rdf:about" (uri psi)))
 	      (cxml:attribute "rdf:nodeID" (make-object-id construct)))
 	  (when (or (> (length (psis construct)) 1)
 		    ii sl t-names
@@ -517,4 +532,35 @@
 					   (eql (instance-of y) isi-subject))
 				       (roles x)))))
 		x))
-	  (elephant:get-instances-by-class 'AssociationC)))))
\ No newline at end of file
+	  (elephant:get-instances-by-class 'AssociationC)))))
+
+
+(defun export-reifier(reifiable-construct)
+  "Exports the reifier-ID-attribute"
+  (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:attribute "rdf:ID" 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."
+  (declare (TopicC top))
+  (when (psis top)
+    (let ((full-uri (uri (first (psis top))))
+	  (err "From get-reifier-uri(): "))
+      (let ((slash-position (find #\/ full-uri :from-end t)))
+	(let ((hash-position (position #\# full-uri)))
+	  (if (and hash-position
+		   (/= (- (length full-uri) 1) hash-position))
+	      (subseq full-uri (- hash-position 1))
+	      (if (and slash-position
+		       (/= (- (length full-uri) 1) slash-position))
+		  (subseq full-uri (+ 1 slash-position))
+		  (if (= hash-position (+ (length full-uri) 1))
+		      (error "~athe PSI-URI ~a ends with an #" err full-uri)
+		      full-uri))))))))
\ No newline at end of file

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	Tue Dec  1 06:05:46 2009
@@ -64,7 +64,7 @@
 
 
 (defun delete-instance-of-association(instance-topic type-topic)
-  "Deletes a type-instance associaiton that corresponds woith the passed
+  "Deletes a type-instance associaiton that corresponds with the passed
    parameters."
   (when (and instance-topic type-topic)
     (let ((instance (get-item-by-psi *instance-psi*))