[isidorus-cvs] r153 - in trunk/src: unit_tests xml/xtm
Lukas Giessmann
lgiessmann at common-lisp.net
Wed Nov 25 14:47:33 UTC 2009
Author: lgiessmann
Date: Wed Nov 25 09:47:32 2009
New Revision: 153
Log:
added reification-support to the xtm2.0-exporter; added also some unit-tests for several cases in the exporter
Modified:
trunk/src/unit_tests/reification_test.lisp
trunk/src/xml/xtm/exporter_xtm2.0.lisp
Modified: trunk/src/unit_tests/reification_test.lisp
==============================================================================
--- trunk/src/unit_tests/reification_test.lisp (original)
+++ trunk/src/unit_tests/reification_test.lisp Wed Nov 25 09:47:32 2009
@@ -28,7 +28,8 @@
:test-merge-reifier-topics
:test-xtm1.0-reification
:test-xtm2.0-reification
- :test-xtm1.0-reification-exporter))
+ :test-xtm1.0-reification-exporter
+ :test-xtm2.0-reification-exporter))
(in-package :reification-test)
@@ -446,11 +447,73 @@
(handler-case (delete-file output-file)
(error () )) ;do nothing
(elephant:close-store))))
-
+
+(test test-xtm2.0-reification-exporter
+ "Tests the reification in the xtm2.0-exporter."
+ (let
+ ((dir "data_base")
+ (output-file "__out__.xtm")
+ (tm-id "http://www.isidor.us/unittests/reification-xtm2.0-tests"))
+ (with-fixture initialize-destination-db (dir)
+ (handler-case (delete-file output-file)
+ (error () )) ;do nothing
+ (xml-importer:import-xtm *reification_xtm2.0.xtm* dir
+ :tm-id tm-id
+ :xtm-id "reification-xtm")
+ (export-xtm output-file :tm-id tm-id)
+ (let ((document
+ (dom:document-element
+ (cxml:parse-file output-file (cxml-dom:make-dom-builder)))))
+ (let ((homer-topic
+ (loop for topic across (xpath-child-elems-by-qname document *xtm2.0-ns* "topic")
+ when (loop for psi across (xpath-child-elems-by-qname topic *xtm2.0-ns* "subjectIdentifier")
+ when (string= (dom:get-attribute psi "href") "http://simpsons.tv/homer")
+ return t)
+ return topic))
+ (married-assoc (xpath-single-child-elem-by-qname document *xtm2.0-ns* "association")))
+ (is-true homer-topic)
+ (is-true married-assoc)
+ (loop for occurrence across (xpath-child-elems-by-qname homer-topic *xtm2.0-ns* "occurrence")
+ do (is (string= (dom:get-attribute occurrence "reifier") "http://simpsons.tv/homer-occurrence")))
+ (loop for name across (xpath-child-elems-by-qname homer-topic *xtm2.0-ns* "name")
+ do (is (string= (dom:get-attribute name "reifier") "http://simpsons.tv/homer-name")))
+ (loop for name across (xpath-child-elems-by-qname homer-topic *xtm2.0-ns* "name")
+ do (loop for variant across (xpath-child-elems-by-qname name *xtm2.0-ns* "variant")
+ do (is (string= (dom:get-attribute variant "reifier") "http://simpsons.tv/homer-name-variant"))))
+ (is (string= (dom:get-attribute married-assoc "reifier") "http://simpsons.tv/married-association"))
+ (is-true (loop for role across (xpath-child-elems-by-qname married-assoc *xtm2.0-ns* "role")
+ when (string= (dom:get-attribute role "reifier") "http://simpsons.tv/married-husband-role")
+ return t))
+ (is-true (loop for topic across (xpath-child-elems-by-qname document *xtm2.0-ns* "topic")
+ when (loop for ii across (xpath-child-elems-by-qname topic *xtm2.0-ns* "itemIdentity")
+ when (string= (dom:get-attribute ii "href") "http://simpsons.tv/homer-occurrence")
+ return t)
+ return t))
+ (is-true (loop for topic across (xpath-child-elems-by-qname document *xtm2.0-ns* "topic")
+ when (loop for ii across (xpath-child-elems-by-qname topic *xtm2.0-ns* "itemIdentity")
+ when (string= (dom:get-attribute ii "href") "http://simpsons.tv/homer-name")
+ return t)
+ return t))
+ (is-true (loop for topic across (xpath-child-elems-by-qname document *xtm2.0-ns* "topic")
+ when (loop for ii across (xpath-child-elems-by-qname topic *xtm2.0-ns* "itemIdentity")
+ when (string= (dom:get-attribute ii "href") "http://simpsons.tv/homer-name-variant")
+ return t)
+ return t))
+ (is-true (loop for topic across (xpath-child-elems-by-qname document *xtm2.0-ns* "topic")
+ when (loop for ii across (xpath-child-elems-by-qname topic *xtm2.0-ns* "itemIdentity")
+ when (string= (dom:get-attribute ii "href") "http://simpsons.tv/married-association")
+ return t)
+ return t))
+ (is-true (loop for topic across (xpath-child-elems-by-qname document *xtm2.0-ns* "topic")
+ when (loop for ii across (xpath-child-elems-by-qname topic *xtm2.0-ns* "itemIdentity")
+ when (string= (dom:get-attribute ii "href") "http://simpsons.tv/married-husband-role")
+ return t)
+ return t)))))
+ (elephant:close-store)))
+
;;TODO: check rdf importer
-;;TODO: check xtm2.0 exporter
;;TODO: check fragment exporter
;;TODO: check merge-reifier-topics (--> versioning)
;;TODO: extend the fragment-importer in the RESTful-interface
@@ -461,4 +524,4 @@
(it.bese.fiveam:run! 'test-xtm1.0-reification)
(it.bese.fiveam:run! 'test-xtm2.0-reification)
(it.bese.fiveam:run! 'test-xtm1.0-reification-exporter)
- )
\ No newline at end of file
+ (it.bese.fiveam:run! 'test-xtm2.0-reification-exporter))
\ No newline at end of file
Modified: trunk/src/xml/xtm/exporter_xtm2.0.lisp
==============================================================================
--- trunk/src/xml/xtm/exporter_xtm2.0.lisp (original)
+++ trunk/src/xml/xtm/exporter_xtm2.0.lisp Wed Nov 25 09:47:32 2009
@@ -9,6 +9,16 @@
(in-package :exporter)
+(defun to-reifier-elem (reifiable-construct)
+ "Exports the reifier-attribute.
+ The attribute is only exported if the reifier-topic contains at least
+ one item-identifier."
+ (declare (ReifiableConstructC reifiable-construct))
+ (when (and (reifier reifiable-construct)
+ (item-identifiers (reifier reifiable-construct)))
+ (cxml:attribute "reifier"
+ (uri (first (item-identifiers (reifier reifiable-construct)))))))
+
(defun ref-to-elem (topic)
(declare (TopicC topic))
(cxml:with-element "t:topicRef"
@@ -29,6 +39,7 @@
"name = element name { reifiable,
type?, scope?, value, variant* }"
(cxml:with-element "t:name"
+ (to-reifier-elem name)
(map 'list #'to-elem (item-identifiers name))
(when (slot-boundp name 'instance-of)
(cxml:with-element "t:type"
@@ -74,6 +85,7 @@
(defmethod to-elem ((variant VariantC))
"variant = element variant { reifiable, scope, (resourceRef | resourceData) }"
(cxml:with-element "t:variant"
+ (to-reifier-elem variant)
(map 'list #'to-elem (item-identifiers variant))
(when (themes variant)
(cxml:with-element "t:scope"
@@ -91,6 +103,7 @@
"occurrence = element occurrence { reifiable,
type, scope?, (resourceRef | resourceData) }"
(cxml:with-element "t:occurrence"
+ (to-reifier-elem occ)
(map 'list #'to-elem (item-identifiers occ))
(cxml:with-element "t:type"
(ref-to-elem (instance-of occ)))
@@ -138,6 +151,7 @@
(defmethod to-elem ((role RoleC))
"role = element role { reifiable, type, topicRef }"
(cxml:with-element "t:role"
+ (to-reifier-elem role)
(map 'list #'to-elem (item-identifiers role))
(cxml:with-element "t:type"
(ref-to-elem (instance-of role)))
@@ -147,6 +161,7 @@
(defmethod to-elem ((assoc AssociationC))
"association = element association { reifiable, type, scope?, role+ }"
(cxml:with-element "t:association"
+ (to-reifier-elem assoc)
(map 'list #'to-elem (item-identifiers assoc))
(cxml:with-element "t:type"
(ref-to-elem (instance-of assoc)))
More information about the Isidorus-cvs
mailing list