[isidorus-cvs] r120 - in trunk/src: . unit_tests xml/rdf
Lukas Giessmann
lgiessmann at common-lisp.net
Wed Aug 26 16:24:42 UTC 2009
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)
+ , at 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
More information about the Isidorus-cvs
mailing list