[isidorus-cvs] r303 - in branches/new-datamodel/src: unit_tests xml/xtm
Lukas Giessmann
lgiessmann at common-lisp.net
Thu Jun 17 17:44:08 UTC 2010
Author: lgiessmann
Date: Thu Jun 17 13:44:08 2010
New Revision: 303
Log:
new-datamodel: adapted the xtm 1.0 exporter to the new datamodel and all corresponding unit-tests; fixed a bug in to-elem-xtm1.0-> TopicC
Modified:
branches/new-datamodel/src/unit_tests/exporter_xtm1.0_test.lisp
branches/new-datamodel/src/xml/xtm/exporter.lisp
branches/new-datamodel/src/xml/xtm/exporter_xtm1.0.lisp
Modified: branches/new-datamodel/src/unit_tests/exporter_xtm1.0_test.lisp
==============================================================================
--- branches/new-datamodel/src/unit_tests/exporter_xtm1.0_test.lisp (original)
+++ branches/new-datamodel/src/unit_tests/exporter_xtm1.0_test.lisp Thu Jun 17 13:44:08 2010
@@ -14,7 +14,8 @@
(test test-std-topics-xtm1.0
(with-fixture refill-test-db ()
(export-xtm *out-xtm1.0-file* :xtm-format '1.0)
- (let ((document (dom:document-element (cxml:parse-file *out-xtm1.0-file* (cxml-dom:make-dom-builder))))
+ (let ((document (dom:document-element
+ (cxml:parse-file *out-xtm1.0-file* (cxml-dom:make-dom-builder))))
(topic-counter 0))
(check-document-structure document 38 2 :ns-uri *xtm1.0-ns*)
(loop for topic across (xpath-child-elems-by-qname document *xtm1.0-ns* "topic")
@@ -22,47 +23,74 @@
(xpath-single-child-elem-by-qname
topic *xtm1.0-ns* "subjectIdentity")
*xtm1.0-ns* "subjectIndicatorRef")
- do (let ((href (dom:get-attribute-ns subjectIndicatorRef *xtm1.0-xlink* "href")))
+ do (let ((href (dom:get-attribute-ns subjectIndicatorRef
+ *xtm1.0-xlink* "href")))
(cond
((string= core-topic-psi href)
(incf topic-counter)
- (format t "name: ~A~%" (xpath-single-child-elem-by-qname topic *xtm1.0-ns* "name")))
+ (format t "name: ~A~%"
+ (xpath-single-child-elem-by-qname topic *xtm1.0-ns*
+ "name")))
((string= core-association-psi href)
(incf topic-counter)
- (format t "name: ~A~%" (xpath-single-child-elem-by-qname topic *xtm1.0-ns* "name")))
+ (format t "name: ~A~%"
+ (xpath-single-child-elem-by-qname topic *xtm1.0-ns*
+ "name")))
((string= core-occurrence-psi href)
(incf topic-counter)
- (format t "name: ~A~%" (xpath-single-child-elem-by-qname topic *xtm1.0-ns* "name")))
+ (format t "name: ~A~%"
+ (xpath-single-child-elem-by-qname topic *xtm1.0-ns*
+ "name")))
((string= core-class-instance-psi href)
(incf topic-counter)
- (format t "name: ~A~%" (xpath-single-child-elem-by-qname topic *xtm1.0-ns* "name")))
+ (format t "name: ~A~%"
+ (xpath-single-child-elem-by-qname topic *xtm1.0-ns*
+ "name")))
((string= core-class-psi href)
(incf topic-counter)
- (format t "name: ~A~%" (xpath-single-child-elem-by-qname topic *xtm1.0-ns* "name")))
+ (format t "name: ~A~%"
+ (xpath-single-child-elem-by-qname topic *xtm1.0-ns*
+ "name")))
((string= core-superclass-subclass-psi href)
(incf topic-counter)
- (format t "name: ~A~%" (xpath-single-child-elem-by-qname topic *xtm1.0-ns* "name")))
+ (format t "name: ~A~%"
+ (xpath-single-child-elem-by-qname topic *xtm1.0-ns*
+ "name")))
((string= core-superclass-psi href)
(incf topic-counter)
- (format t "name: ~A~%" (xpath-single-child-elem-by-qname topic *xtm1.0-ns* "name")))
+ (format t "name: ~A~%"
+ (xpath-single-child-elem-by-qname topic *xtm1.0-ns*
+ "name")))
((string= core-subclass-psi href)
(incf topic-counter)
- (format t "name: ~A~%" (xpath-single-child-elem-by-qname topic *xtm1.0-ns* "name")))
+ (format t "name: ~A~%"
+ (xpath-single-child-elem-by-qname topic *xtm1.0-ns*
+ "name")))
((string= core-sort-psi href)
(incf topic-counter)
- (format t "name: ~A~%" (xpath-single-child-elem-by-qname topic *xtm1.0-ns* "name")))
+ (format t "name: ~A~%"
+ (xpath-single-child-elem-by-qname topic *xtm1.0-ns*
+ "name")))
((string= core-display-psi href)
(incf topic-counter)
- (format t "name: ~A~%" (xpath-single-child-elem-by-qname topic *xtm1.0-ns* "name")))
+ (format t "name: ~A~%"
+ (xpath-single-child-elem-by-qname topic *xtm1.0-ns*
+ "name")))
((string= core-type-instance-psi href)
(incf topic-counter)
- (format t "name: ~A~%" (xpath-single-child-elem-by-qname topic *xtm1.0-ns* "name")))
+ (format t "name: ~A~%"
+ (xpath-single-child-elem-by-qname topic *xtm1.0-ns*
+ "name")))
((string= core-type-psi href)
(incf topic-counter)
- (format t "name: ~A~%" (xpath-single-child-elem-by-qname topic *xtm1.0-ns* "name")))
+ (format t "name: ~A~%"
+ (xpath-single-child-elem-by-qname topic *xtm1.0-ns*
+ "name")))
((string= core-instance-psi href)
(incf topic-counter)
- (format t "name: ~A~%" (xpath-single-child-elem-by-qname topic *xtm1.0-ns* "name")))))))
+ (format t "name: ~A~%"
+ (xpath-single-child-elem-by-qname topic *xtm1.0-ns*
+ "name")))))))
(is (= topic-counter 13)))))
Modified: branches/new-datamodel/src/xml/xtm/exporter.lisp
==============================================================================
--- branches/new-datamodel/src/xml/xtm/exporter.lisp (original)
+++ branches/new-datamodel/src/xml/xtm/exporter.lisp Thu Jun 17 13:44:08 2010
@@ -56,6 +56,7 @@
"t:topicMap" :empty
, at body))))
+
(defmacro export-to-elem (tm to-elem)
`(setf *export-tm* ,tm)
`(format t "*export-tm*: ~a" *export-tm*)
@@ -94,7 +95,7 @@
(to-elem elem revision))))
(with-xtm1.0
(export-to-elem tm #'(lambda(elem)
- (to-elem elem revision)))))))))))
+ (to-elem-xtm1.0 elem revision)))))))))))
(defun export-xtm-to-string (&key
@@ -109,13 +110,11 @@
(cxml:with-xml-output (cxml:make-string-sink :canonical nil)
(if (eq xtm-format '2.0)
(with-xtm2.0
- ;(export-to-elem tm #'to-elem))
(export-to-elem tm #'(lambda(elem)
(to-elem elem revision))))
(with-xtm1.0
- ;(export-to-elem tm #'to-elem-xtm1.0))))))))
(export-to-elem tm #'(lambda(elem)
- (to-elem elem revision))))))))))
+ (to-elem-xtm1.0 elem revision))))))))))
(defun export-xtm-fragment (fragment &key (xtm-format '2.0))
@@ -127,5 +126,4 @@
(with-xtm2.0
(to-elem fragment (revision fragment)))
(with-xtm1.0
- (to-elem-xtm1.0 fragment (revision fragment))))))))
-
\ No newline at end of file
+ (to-elem-xtm1.0 fragment (revision fragment))))))))
\ No newline at end of file
Modified: branches/new-datamodel/src/xml/xtm/exporter_xtm1.0.lisp
==============================================================================
--- branches/new-datamodel/src/xml/xtm/exporter_xtm1.0.lisp (original)
+++ branches/new-datamodel/src/xml/xtm/exporter_xtm1.0.lisp Thu Jun 17 13:44:08 2010
@@ -52,9 +52,11 @@
(when (and (stringp (uri x))
(> (length (uri x)) 0))
(eql (elt (uri x) 0) #\#)))
- (psis (reifier reifiable-construct :revision revision) :revision revision))))
+ (psis (reifier reifiable-construct :revision revision)
+ :revision revision))))
(when reifier-psi
- (cxml:attribute "id" (subseq (uri reifier-psi) 1 (length (uri reifier-psi))))))))
+ (cxml:attribute "id" (subseq (uri reifier-psi) 1
+ (length (uri reifier-psi))))))))
(defun to-resourceX-elem-xtm1.0 (characteristic revision)
@@ -177,9 +179,9 @@
(first-locator (when (locators topic :revision revision)
(first (locators topic :revision revision)))))
(when (or t-psis first-locator)
- (to-subjectIdentity-elem-xtm1.0 t-psis first-locator topic)))
+ (to-subjectIdentity-elem-xtm1.0 t-psis first-locator revision)))
(when (names topic :revision revision)
- (map 'list #'(lambda(x)
+ (map 'list #'(lambda(x)
(to-elem-xtm1.0 x revision))
(names topic :revision revision)))
(when (occurrences topic :revision revision)
More information about the Isidorus-cvs
mailing list