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*))