Author: lgiessmann Date: Wed Aug 26 12:24:42 2009 New Revision: 120 Log: rdf:exporter: added the macro with-property and some unit tests Modified: trunk/src/isidorus.asd trunk/src/unit_tests/fixtures.lisp trunk/src/unit_tests/poems_light.xtm trunk/src/unit_tests/rdf_importer_test.lisp trunk/src/unit_tests/unittests-constants.lisp trunk/src/xml/rdf/exporter.lisp Modified: trunk/src/isidorus.asd ============================================================================== --- trunk/src/isidorus.asd (original) +++ trunk/src/isidorus.asd Wed Aug 26 12:24:42 2009 @@ -138,6 +138,8 @@ :depends-on ("fixtures")) (:file "threading_test") (:file "rdf_importer_test" + :depends-on ("fixtures")) + (:file "rdf_exporter_test" :depends-on ("fixtures"))) :depends-on ("atom" "constants" Modified: trunk/src/unit_tests/fixtures.lisp ============================================================================== --- trunk/src/unit_tests/fixtures.lisp (original) +++ trunk/src/unit_tests/fixtures.lisp Wed Aug 26 12:24:42 2009 @@ -30,7 +30,7 @@ :merge-test-db :set-up-test-db :tear-down-test-db - + :rdf-exporter-test-db :*TEST-TM* :*NOTIFICATIONBASE-TM* :*XTM-TM* @@ -191,4 +191,23 @@ :document-id document-id) (elephant:open-store (xml-importer:get-store-spec db-dir)) (&body) + (tear-down-test-db))) + + +(def-fixture rdf-exporter-test-db() + (let ((db-dir "data_base") + (tm-id "http://test-tm") + (document-id "doc-id") + (exported-file-path "./__out__.rdf")) + (clean-out-db db-dir) + (handler-case (delete-file exported-file-path) + (error () )) ;do nothing + (setf d:*current-xtm* document-id) + (setup-repository *poems_light.xtm* db-dir :tm-id tm-id + :xtm-id document-id) + (elephant:open-store (xml-importer:get-store-spec db-dir)) + (rdf-exporter:export-rdf exported-file-path :tm-id tm-id) + (&body) + (handler-case (delete-file exported-file-path) + (error () )) ;do nothing (tear-down-test-db))) \ No newline at end of file Modified: trunk/src/unit_tests/poems_light.xtm ============================================================================== --- trunk/src/unit_tests/poems_light.xtm (original) +++ trunk/src/unit_tests/poems_light.xtm Wed Aug 26 12:24:42 2009 @@ -7,6 +7,7 @@ <tm:subjectIdentifier href="http://some.where/author/Goethe"/> <tm:instanceOf><tm:topicRef href="#author"/></tm:instanceOf> <tm:name> + <tm:itemIdentity href="http://some.where/name_ii_1"/> <tm:type><tm:topicRef href="#firstName"/></tm:type> <tm:value>Johann Wolfgang</tm:value> </tm:name> @@ -17,7 +18,7 @@ </tm:topic> <tm:topic id="UUID-born-event"> - <tm:instanceOf href="#event"/> + <tm:instanceOf><tm:topicRef href="#event"/></tm:instanceOf> <tm:occurrence> <tm:type><tm:topicRef href="#date"/></tm:type> <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#date">28.08.1749</tm:resourceData> @@ -55,6 +56,10 @@ <tm:subjectIdentifier href="http://some.where/metropolis/Berlin"/> <tm:instanceOf><tm:topicRef href="#metropolis"/></tm:instanceOf> <tm:occurrence> + <tm:type><tm:topicRef href="#fullName"/></tm:type> + <tm:resourceData>Berlin</tm:resourceData> + </tm:occurrence> + <tm:occurrence> <tm:type><tm:topicRef href="#population"/></tm:type> <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#unsignedLong">3431473</tm:resourceData> </tm:occurrence> @@ -72,6 +77,10 @@ <tm:subjectIdentifier href="http://some.where/city/Weimar"/> <tm:instanceOf><tm:topicRef href="#city"/></tm:instanceOf> <tm:occurrence> + <tm:type><tm:topicRef href="#fullName"/></tm:type> + <tm:resourceData>Weimar</tm:resourceData> + </tm:occurrence> + <tm:occurrence> <tm:type><tm:topicRef href="#population"/></tm:type> <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#unsignedLong">64720</tm:resourceData> </tm:occurrence> @@ -86,6 +95,8 @@ <tm:subjectLocator href="http://some.where/resource_2"/> <tm:instanceOf><tm:topicRef href="#poem"/></tm:instanceOf> <tm:occurrence> + <tm:itemIdentity href="http://some.where/occurrence_ii_1"/> + <tm:itemIdentity href="http://some.where/occurrence_ii_2"/> <tm:type><tm:topicRef href="#title"/></tm:type> <tm:scope> <tm:topicRef href="#de"/> @@ -147,7 +158,7 @@ <tm:occurrence> <tm:type><tm:topicRef href="#content"/></tm:type> <tm:scope><tm:topicRef href="#de"/></tm:scope> - <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string"> Bedecke deinen Himmel, Zeus, ... </tm:resourceData> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string">Bedecke deinen Himmel, Zeus, ...</tm:resourceData> </tm:occurrence> </tm:topic> @@ -284,7 +295,7 @@ </tm:topic> <tm:topic id="lastName"> - <tm:subjectIdentifier href="http://some.where/relationsip/lastName"/> + <tm:subjectIdentifier href="http://some.where/relationship/lastName"/> </tm:topic> <tm:topic id="event"> @@ -589,6 +600,11 @@ <tm:name> <tm:type><tm:topicRef href="#firstName"/></tm:type> <tm:value>Johann Christoph Friedrich</tm:value> + <tm:variant> + <tm:itemIdentity href="http://some.where/variant_ii_1"/> + <tm:scope><tm:topicRef href="#display"/></tm:scope> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string">Friedrich</tm:resourceData> + </tm:variant> </tm:name> <tm:name> <tm:type><tm:topicRef href="#lastName"/></tm:type> @@ -600,6 +616,10 @@ </tm:occurrence> </tm:topic> + <tm:topic id="display"> + <tm:subjectIdentifier href="http://www.topicmaps.org/xtm/1.0/core.xtm#display"/> + </tm:topic> + <tm:topic id="associatedWithEachOther"> <tm:subjectIdentifier href="http://some.where/relationship/associatedWithEachOther"/> </tm:topic> @@ -628,6 +648,7 @@ <tm:topicRef href="#poem"/> </tm:role> <tm:role> + <tm:itemIdentity href="http://some.where/test-role"/> <tm:type><tm:topicRef href="#literature"/></tm:type> <tm:topicRef href="#ballad"/> </tm:role> Modified: trunk/src/unit_tests/rdf_importer_test.lisp ============================================================================== --- trunk/src/unit_tests/rdf_importer_test.lisp (original) +++ trunk/src/unit_tests/rdf_importer_test.lisp Wed Aug 26 12:24:42 2009 @@ -32,8 +32,7 @@ *rdf-subject* *rdf-object* *rdf-predicate* - *rdf-statement* - *xml-string*) + *rdf-statement*) (:import-from :xml-tools xpath-child-elems-by-qname xpath-single-child-elem-by-qname Modified: trunk/src/unit_tests/unittests-constants.lisp ============================================================================== --- trunk/src/unit_tests/unittests-constants.lisp (original) +++ trunk/src/unit_tests/unittests-constants.lisp Wed Aug 26 12:24:42 2009 @@ -29,7 +29,8 @@ :*t100.xtm* :*atom_test.xtm* :*atom-conf.lisp* - :*poems_light.rdf*)) + :*poems_light.rdf* + :*poems_light.xtm*)) (in-package :unittests-constants) @@ -93,4 +94,8 @@ (defparameter *poems_light.rdf* (asdf:component-pathname - (asdf:find-component *unit-tests-component* "poems_light.rdf"))) \ No newline at end of file + (asdf:find-component *unit-tests-component* "poems_light.rdf"))) + +(defparameter *poems_light.xtm* + (asdf:component-pathname + (asdf:find-component *unit-tests-component* "poems_light.xtm"))) Modified: trunk/src/xml/rdf/exporter.lisp ============================================================================== --- trunk/src/xml/rdf/exporter.lisp (original) +++ trunk/src/xml/rdf/exporter.lisp Wed Aug 26 12:24:42 2009 @@ -35,6 +35,21 @@ (defvar *ns-map* nil) ;; ((:prefix <string> :uri <string>)) +(defmacro with-property (construct &body body) + "Generates a property element with a corresponding namespace + and tag name before executing the body. This macro is for usin + in occurrences and association that are mapped to RDF properties." + `(let ((ns-list + (separate-uri (uri (first (psis (instance-of ,construct))))))) + (declare ((or OccurrenceC AssociationC) ,construct)) + (let ((ns (getf ns-list :prefix)) + (tag-name (getf ns-list :suffix))) + (cxml:with-namespace ((get-ns-prefix ns) ns) + (cxml:with-element (concatenate 'string (get-ns-prefix ns) + ":" tag-name) + ,@body))))) + + (defun export-rdf (rdf-path &key tm-id (revision (get-revision))) "Exports the topoic map bound to tm-id as RDF." (with-reader-lock @@ -206,6 +221,7 @@ properties itemIdentity, scope and value." (cxml:with-element "isi:variant" (cxml:attribute "rdf:parseType" "Resource") + (make-isi-type "Variant") (map 'list #'to-rdf-elem (item-identifiers construct)) (scopes-to-rdf-elems construct) (resourceX-to-rdf-elem construct))) @@ -216,7 +232,7 @@ properties itemIdentity, nametype, value, variant and scope." (cxml:with-element "isi:name" (cxml:attribute "rdf:parseType" "Resource") - (make-isi-type "name") + (make-isi-type "Name") (map 'list #'to-rdf-elem (item-identifiers construct)) (cxml:with-element "isi:nametype" (make-topic-reference (instance-of construct))) @@ -240,24 +256,18 @@ (/= (length (psis (instance-of construct))) 1)) (cxml:with-element "isi:occurrence" (cxml:attribute "rdf:parseType" "Resource") - (make-isi-type "occurrence") + (make-isi-type "Occurrence") (map 'list #'to-rdf-elem (item-identifiers construct)) (cxml:with-element "isi:occurrencetype" (make-topic-reference (instance-of construct))) (scopes-to-rdf-elems construct) (resourceX-to-rdf-elem construct)) - (let ((ns-list - (separate-uri (uri (first (psis (instance-of construct))))))) - (let ((ns (getf ns-list :prefix)) - (tag-name (getf ns-list :suffix))) - (cxml:with-namespace ((get-ns-prefix ns) ns) - (cxml:with-element (concatenate 'string (get-ns-prefix ns) - ":" tag-name) - (cxml:attribute "rdf:datatype" (datatype construct)) - (when (themes construct) - (cxml:attribute "xml:lang" (get-xml-lang - (first (themes construct))))) - (cxml:text (charvalue construct))))))))) + (with-property construct + (cxml:attribute "rdf:datatype" (datatype construct)) + (when (themes construct) + (cxml:attribute "xml:lang" (get-xml-lang + (first (themes construct))))) + (cxml:text (charvalue construct)))))) (defmethod to-rdf-elem ((construct TopicC)) @@ -269,9 +279,9 @@ (occurrences construct))) (or (used-as-type construct) (used-as-theme construct) - (player-in-roles construct))) + (xml-lang-p construct))) nil ;; do not export this topic explicitly, since it has been exported as - ;; rdf:resource, rdf:about or any other reference + ;; rdf:resource, property or any other reference (cxml:with-element "rdf:Description" (let ((psi (when (psis construct) (first (psis construct)))) @@ -285,7 +295,7 @@ (when (or (> (length (psis construct)) 1) ii sl t-names (isi-occurrence-p construct)) - (make-isi-type "topic")) + (make-isi-type "Topic")) (map 'list #'to-rdf-elem (remove psi (psis construct))) (map 'list #'to-rdf-elem sl) (map 'list #'to-rdf-elem ii) @@ -336,7 +346,7 @@ (association-roles (roles association))) (cxml:with-element "rdf:Description" (cxml:attribute "rdf:nodeID" (make-object-id association)) - (make-isi-type "association") + (make-isi-type "Association") (cxml:with-element "isi:associationtype" (make-topic-reference association-type)) (map 'list #'to-rdf-elem ii) @@ -352,7 +362,7 @@ (player-top (player construct))) (cxml:with-element "isi:role" (cxml:attribute "rdf:parseType" "Resource") - (make-isi-type "role") + (make-isi-type "Role") (map 'list #'to-rdf-elem ii) (cxml:with-element "isi:roletype" (make-topic-reference role-type)) @@ -384,12 +394,5 @@ (cxml:attribute "rdf:about" (uri psi)) (cxml:attribute "rdf:nodeID" (make-object-id (player subject-role)))) - (let ((ns-list - (separate-uri (uri - (first (psis (instance-of association))))))) - (let ((ns (getf ns-list :prefix)) - (tag-name (getf ns-list :suffix))) - (cxml:with-namespace ((get-ns-prefix ns) ns) - (cxml:with-element (concatenate 'string (get-ns-prefix ns) - ":" tag-name) - (make-topic-reference (player object-role)))))))))))) \ No newline at end of file + (with-property association + (make-topic-reference (player object-role))))))))) \ No newline at end of file