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 ,@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)