[isidorus-cvs] r152 - in trunk/src: model unit_tests xml/xtm
Lukas Giessmann
lgiessmann at common-lisp.net
Wed Nov 25 13:05:03 UTC 2009
Author: lgiessmann
Date: Wed Nov 25 08:05:02 2009
New Revision: 152
Log:
added the support for reification to the xtm1.0 exporter; added alos some unit-tests for the exporter
Modified:
trunk/src/model/datamodel.lisp
trunk/src/unit_tests/reification_test.lisp
trunk/src/xml/xtm/exporter_xtm1.0.lisp
Modified: trunk/src/model/datamodel.lisp
==============================================================================
--- trunk/src/model/datamodel.lisp (original)
+++ trunk/src/model/datamodel.lisp Wed Nov 25 08:05:02 2009
@@ -1245,9 +1245,9 @@
(if tm
(remove-if-not
(lambda (role)
- (format t "player: ~a" (player role))
- (format t "parent: ~a" (parent role))
- (format t "topic: ~a~&" topic)
+ ;(format t "player: ~a" (player role))
+ ;(format t "parent: ~a" (parent role))
+ ;(format t "topic: ~a~&" topic)
(in-topicmap tm (parent role)))
(player-in-roles topic))
(player-in-roles topic)))))
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 08:05:02 2009
@@ -13,13 +13,22 @@
:datamodel
:it.bese.FiveAM
:unittests-constants
- :fixtures)
+ :fixtures
+ :exporter)
+ (:import-from :constants
+ *xtm2.0-ns*
+ *xtm1.0-ns*
+ *xtm1.0-xlink*)
+ (:import-from :xml-tools
+ xpath-child-elems-by-qname xpath-single-child-elem-by-qname
+ xpath-fn-string)
(:export
:reification-test
:run-reification-tests
:test-merge-reifier-topics
:test-xtm1.0-reification
- :test-xtm2.0-reification))
+ :test-xtm2.0-reification
+ :test-xtm1.0-reification-exporter))
(in-package :reification-test)
@@ -348,8 +357,99 @@
(elephant:close-store))))
+(test test-xtm1.0-reification-exporter
+ "Tests the reification in the xtm1.0-exporter."
+ (let
+ ((dir "data_base")
+ (output-file "__out__.xtm")
+ (tm-id "http://www.isidor.us/unittests/reification-xtm1.0-tests"))
+ (with-fixture initialize-destination-db (dir)
+ (handler-case (delete-file output-file)
+ (error () )) ;do nothing
+ (xml-importer:import-xtm *reification_xtm1.0.xtm* dir
+ :tm-id tm-id
+ :xtm-id "reification-xtm"
+ :xtm-format '1.0)
+ (export-xtm output-file :xtm-format '1.0 :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 *xtm1.0-ns* "topic")
+ when (loop for subjectIndicatorRef across (xpath-child-elems-by-qname
+ (xpath-single-child-elem-by-qname
+ topic *xtm1.0-ns* "subjectIdentity")
+ *xtm1.0-ns* "subjectIndicatorRef")
+ when (string= (dom:get-attribute-ns subjectIndicatorRef *xtm1.0-xlink* "href")
+ "http://simpsons.tv/homer")
+ return t)
+ return topic))
+ (married-assoc (xpath-single-child-elem-by-qname document *xtm1.0-ns* "association")))
+ (is-true homer-topic)
+ (is-true married-assoc)
+ (loop for occurrence across (xpath-child-elems-by-qname homer-topic *xtm1.0-ns* "occurrence")
+ do (is (string= (dom:get-attribute occurrence "id") "homer-occurrence")))
+ (loop for name across (xpath-child-elems-by-qname homer-topic *xtm1.0-ns* "baseName")
+ do (progn (is (string= (dom:get-attribute name "id") "homer-name"))
+ (loop for variant across (xpath-child-elems-by-qname name *xtm1.0-ns* "variant")
+ do (is (string= (dom:get-attribute variant "id") "homer-name-variant")))))
+ (is (string= (dom:get-attribute married-assoc "id") "a-married"))
+ (is-true (loop for role across (xpath-child-elems-by-qname married-assoc *xtm1.0-ns* "member")
+ when (string= (dom:get-attribute role "id")
+ "married-husband-role")
+ return t)))
+ (is-true (loop for topic across (xpath-child-elems-by-qname document *xtm1.0-ns* "topic")
+ when (loop for subjectIndicatorRef across (xpath-child-elems-by-qname
+ (xpath-single-child-elem-by-qname
+ topic *xtm1.0-ns* "subjectIdentity")
+ *xtm1.0-ns* "subjectIndicatorRef")
+ when (string= (dom:get-attribute-ns subjectIndicatorRef *xtm1.0-xlink* "href")
+ "#homer-occurrence")
+ return t)
+ return t))
+ (is-true (loop for topic across (xpath-child-elems-by-qname document *xtm1.0-ns* "topic")
+ when (loop for subjectIndicatorRef across (xpath-child-elems-by-qname
+ (xpath-single-child-elem-by-qname
+ topic *xtm1.0-ns* "subjectIdentity")
+ *xtm1.0-ns* "subjectIndicatorRef")
+ when (string= (dom:get-attribute-ns subjectIndicatorRef *xtm1.0-xlink* "href")
+ "#homer-name")
+ return t)
+ return t))
+ (is-true (loop for topic across (xpath-child-elems-by-qname document *xtm1.0-ns* "topic")
+ when (loop for subjectIndicatorRef across (xpath-child-elems-by-qname
+ (xpath-single-child-elem-by-qname
+ topic *xtm1.0-ns* "subjectIdentity")
+ *xtm1.0-ns* "subjectIndicatorRef")
+ when (string= (dom:get-attribute-ns subjectIndicatorRef *xtm1.0-xlink* "href")
+ "#homer-name-variant")
+ return t)
+ return t))
+ (is-true (loop for topic across (xpath-child-elems-by-qname document *xtm1.0-ns* "topic")
+ when (loop for subjectIndicatorRef across (xpath-child-elems-by-qname
+ (xpath-single-child-elem-by-qname
+ topic *xtm1.0-ns* "subjectIdentity")
+ *xtm1.0-ns* "subjectIndicatorRef")
+ when (string= (dom:get-attribute-ns subjectIndicatorRef *xtm1.0-xlink* "href")
+ "#a-married")
+ return t)
+ return t))
+ (is-true (loop for topic across (xpath-child-elems-by-qname document *xtm1.0-ns* "topic")
+ when (loop for subjectIndicatorRef across (xpath-child-elems-by-qname
+ (xpath-single-child-elem-by-qname
+ topic *xtm1.0-ns* "subjectIdentity")
+ *xtm1.0-ns* "subjectIndicatorRef")
+ when (string= (dom:get-attribute-ns subjectIndicatorRef *xtm1.0-xlink* "href")
+ "#married-husband-role")
+ return t)
+ return t)))
+ (handler-case (delete-file output-file)
+ (error () )) ;do nothing
+ (elephant:close-store))))
+
+
+
;;TODO: check rdf importer
-;;TODO: check xtm1.0 exporter
;;TODO: check xtm2.0 exporter
;;TODO: check fragment exporter
;;TODO: check merge-reifier-topics (--> versioning)
@@ -360,4 +460,5 @@
(it.bese.fiveam:run! 'test-merge-reifier-topics)
(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
Modified: trunk/src/xml/xtm/exporter_xtm1.0.lisp
==============================================================================
--- trunk/src/xml/xtm/exporter_xtm1.0.lisp (original)
+++ trunk/src/xml/xtm/exporter_xtm1.0.lisp Wed Nov 25 08:05:02 2009
@@ -34,6 +34,23 @@
(cxml:attribute "xlink:href" (format nil "#~a" (topicid topic)))))
+(defun to-reifier-elem-xtm1.0 (reifiable-construct)
+ "Exports an ID indicating a reifier.
+ The reifier is only exported if the reifier-topic contains a PSI starting with #.
+ This may cause differences since the xtm2.0 defines the referencing
+ of reifiers with item-identifiers."
+ (declare (ReifiableConstructC reifiable-construct))
+ (when (reifier reifiable-construct)
+ (let ((reifier-psi
+ (find-if #'(lambda(x)
+ (when (and (stringp (uri x))
+ (> (length (uri x)) 0))
+ (eql (elt (uri x) 0) #\#)))
+ (psis (reifier reifiable-construct)))))
+ (when reifier-psi
+ (cxml:attribute "id" (subseq (uri reifier-psi) 1 (length (uri reifier-psi))))))))
+
+
(defun to-resourceX-elem-xtm1.0 (characteristic)
(declare (CharacteristicC characteristic))
(let ((characteristic-value
@@ -90,6 +107,7 @@
(defmethod to-elem-xtm1.0 ((variant VariantC))
"variant = element { parameters, variantName?, variant* }"
(cxml:with-element "t:variant"
+ (to-reifier-elem-xtm1.0 variant)
(when (themes variant)
(cxml:with-element "t:parameters"
(map 'list #'to-topicRef-elem-xtm1.0 (themes variant))))
@@ -100,6 +118,7 @@
(defmethod to-elem-xtm1.0 ((name NameC))
"baseName = element baseName { scope?, baseNameString, variant* }"
(cxml:with-element "t:baseName"
+ (to-reifier-elem-xtm1.0 name)
(when (themes name)
(to-scope-elem-xtm1.0 name))
(cxml:with-element "t:baseNameString"
@@ -114,6 +133,7 @@
"occurrence = element occurrence { instanceOf?, scope?,
(resourceRef | resourceData) }"
(cxml:with-element "t:occurrence"
+ (to-reifier-elem-xtm1.0 occurrence)
(when (instance-of occurrence)
(to-instanceOf-elem-xtm1.0 (instance-of occurrence)))
(when (themes occurrence)
@@ -146,6 +166,7 @@
"member = element member { roleSpec?,
(topicRef | resourceRef | subjectIndicatorRef)+ }"
(cxml:with-element "t:member"
+ (to-reifier-elem-xtm1.0 role)
(when (instance-of role)
(to-roleSpec-elem-xtm1.0 (instance-of role)))
(to-topicRef-elem-xtm1.0 (player role))))
@@ -154,6 +175,7 @@
(defmethod to-elem-xtm1.0 ((association AssociationC))
"association = element association { instanceOf?, scope?, member+ }"
(cxml:with-element "t:association"
+ (to-reifier-elem-xtm1.0 association)
(when (instance-of association)
(to-instanceOf-elem-xtm1.0 (instance-of association)))
(when (themes association)
More information about the Isidorus-cvs
mailing list