Author: lgiessmann Date: Thu Jun 17 12:10:37 2010 New Revision: 301

Log: new-datamodel: adapted the xtm 1.0 exporter to the new datamodel; fixed a bug in list-extern-associations

Modified: branches/new-datamodel/src/unit_tests/exporter_xtm2.0_test.lisp branches/new-datamodel/src/xml/xtm/exporter.lisp branches/new-datamodel/src/xml/xtm/exporter_xtm1.0.lisp branches/new-datamodel/src/xml/xtm/exporter_xtm2.0.lisp

Modified: branches/new-datamodel/src/unit_tests/exporter_xtm2.0_test.lisp ============================================================================== --- branches/new-datamodel/src/unit_tests/exporter_xtm2.0_test.lisp (original) +++ branches/new-datamodel/src/unit_tests/exporter_xtm2.0_test.lisp Thu Jun 17 12:10:37 2010 @@ -51,7 +51,8 @@ :test-exporter-xtm2.0-versions-1 :test-exporter-xtm2.0-versions-2 :test-exporter-xtm2.0-versions-3 :test-fragments-versions :test-exporter-xtm1.0-versions-1 :test-exporter-xtm1.0-versions-2 - :test-exporter-xtm1.0-versions-3 :test-fragments-xtm1.0-versions)) + :test-exporter-xtm1.0-versions-3 :test-fragments-xtm1.0-versions + :exporter-tests))

(in-package :exporter-test) (def-suite exporter-tests) @@ -69,8 +70,8 @@ (error () )) ;do nothing (handler-case (delete-file *out-xtm1.0-file*) (error () )) ;do nothing - (setup-repository *sample_objects_2_0.xtm* "data_base" :xtm-id "test-tm") - (elephant:open-store (get-store-spec "data_base"))) + (setup-repository *sample_objects_2_0.xtm* "data_base" :xtm-id "test-tm")) + ;(elephant:open-store (get-store-spec "data_base")))

(def-fixture refill-test-db () @@ -551,52 +552,82 @@ (test test-std-topics (with-fixture refill-test-db () (export-xtm *out-xtm2.0-file*) - (let ((document (dom:document-element (cxml:parse-file *out-xtm2.0-file* (cxml-dom:make-dom-builder)))) + (let ((document (dom:document-element + (cxml:parse-file *out-xtm2.0-file* + (cxml-dom:make-dom-builder)))) (topic-counter 0)) (check-document-structure document 38 2) (loop for topic across (xpath-child-elems-by-qname document *xtm2.0-ns* "topic") - do (loop for subjectIdentifier across (xpath-child-elems-by-qname topic *xtm2.0-ns* "subjectIdentifier") - do (let ((href (dom:node-value (dom:get-attribute-node subjectIdentifier "href")))) + do (loop for subjectIdentifier across + (xpath-child-elems-by-qname topic *xtm2.0-ns* "subjectIdentifier") + do (let ((href (dom:node-value + (dom:get-attribute-node subjectIdentifier "href")))) (cond ((string= core-topic-psi href) (incf topic-counter) - (format t "name: ~A~%" (xpath-single-child-elem-by-qname topic *xtm2.0-ns* "name"))) + (format t "name: ~A~%" + (xpath-single-child-elem-by-qname topic *xtm2.0-ns* + "name"))) ((string= core-association-psi href) (incf topic-counter) - (format t "name: ~A~%" (xpath-single-child-elem-by-qname topic *xtm2.0-ns* "name"))) + (format t "name: ~A~%" + (xpath-single-child-elem-by-qname topic *xtm2.0-ns* + "name"))) ((string= core-occurrence-psi href) (incf topic-counter) - (format t "name: ~A~%" (xpath-single-child-elem-by-qname topic *xtm2.0-ns* "name"))) + (format t "name: ~A~%" + (xpath-single-child-elem-by-qname topic *xtm2.0-ns* + "name"))) ((string= core-class-instance-psi href) (incf topic-counter) - (format t "name: ~A~%" (xpath-single-child-elem-by-qname topic *xtm2.0-ns* "name"))) + (format t "name: ~A~%" + (xpath-single-child-elem-by-qname topic *xtm2.0-ns* + "name"))) ((string= core-class-psi href) (incf topic-counter) - (format t "name: ~A~%" (xpath-single-child-elem-by-qname topic *xtm2.0-ns* "name"))) + (format t "name: ~A~%" + (xpath-single-child-elem-by-qname topic *xtm2.0-ns* + "name"))) ((string= core-superclass-subclass-psi href) (incf topic-counter) - (format t "name: ~A~%" (xpath-single-child-elem-by-qname topic *xtm2.0-ns* "name"))) + (format t "name: ~A~%" + (xpath-single-child-elem-by-qname topic *xtm2.0-ns* + "name"))) ((string= core-superclass-psi href) (incf topic-counter) - (format t "name: ~A~%" (xpath-single-child-elem-by-qname topic *xtm2.0-ns* "name"))) + (format t "name: ~A~%" + (xpath-single-child-elem-by-qname topic *xtm2.0-ns* + "name"))) ((string= core-subclass-psi href) (incf topic-counter) - (format t "name: ~A~%" (xpath-single-child-elem-by-qname topic *xtm2.0-ns* "name"))) + (format t "name: ~A~%" + (xpath-single-child-elem-by-qname topic *xtm2.0-ns* + "name"))) ((string= core-sort-psi href) (incf topic-counter) - (format t "name: ~A~%" (xpath-single-child-elem-by-qname topic *xtm2.0-ns* "name"))) + (format t "name: ~A~%" + (xpath-single-child-elem-by-qname topic *xtm2.0-ns* + "name"))) ((string= core-display-psi href) (incf topic-counter) - (format t "name: ~A~%" (xpath-single-child-elem-by-qname topic *xtm2.0-ns* "name"))) + (format t "name: ~A~%" + (xpath-single-child-elem-by-qname topic *xtm2.0-ns* + "name"))) ((string= core-type-instance-psi href) (incf topic-counter) - (format t "name: ~A~%" (xpath-single-child-elem-by-qname topic *xtm2.0-ns* "name"))) + (format t "name: ~A~%" + (xpath-single-child-elem-by-qname topic *xtm2.0-ns* + "name"))) ((string= core-type-psi href) (incf topic-counter) - (format t "name: ~A~%" (xpath-single-child-elem-by-qname topic *xtm2.0-ns* "name"))) + (format t "name: ~A~%" + (xpath-single-child-elem-by-qname topic *xtm2.0-ns* + "name"))) ((string= core-instance-psi href) (incf topic-counter) - (format t "name: ~A~%" (xpath-single-child-elem-by-qname topic *xtm2.0-ns* "name"))))))) + (format t "name: ~A~%" + (xpath-single-child-elem-by-qname topic *xtm2.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 12:10:37 2010 @@ -10,19 +10,32 @@ (in-package :exporter)

-(defun list-extern-associations () +(defun list-extern-associations (&key (revision *TM-REVISION*)) "gets all instances of AssociationC - which does not realize an instanceOf relationship in the db" (let ((instance-topic (identified-construct - (elephant:get-instance-by-value 'PersistentIdC 'uri "http://psi.topicmaps.org/iso13250/model/instance"))) + (elephant:get-instance-by-value 'PersistentIdC 'uri *instance-psi*))) (type-topic (identified-construct - (elephant:get-instance-by-value 'PersistentIdC 'uri "http://psi.topicmaps.org/iso13250/model/type")))) + (elephant:get-instance-by-value 'PersistentIdC 'uri *type-psi*)))) (loop for item in (elephant:get-instances-by-class 'AssociationC) - when (not (and (or (eq instance-topic (instance-of (first (roles item)))) - (eq instance-topic (instance-of (second (roles item))))) - (or (eq type-topic (instance-of (first (roles item)))) - (eq type-topic (instance-of (second (roles item))))))) + when (and (= (length (roles item :revision revision)) 2) + (not (and (or (eq instance-topic + (instance-of (first (roles item + :revision revision)) + :revision revision)) + (eq instance-topic + (instance-of (second (roles item + :revision revision)) + :revision revision))) + (or (eq type-topic + (instance-of (first (roles item + :revision revision)) + :revision revision)) + (eq type-topic + (instance-of (second (roles item + :revision revision)) + :revision revision)))))) collect item)))

@@ -53,12 +66,13 @@ (map 'list #'(lambda(top) (d:find-item-by-revision top revision)) - (if ,tm - (union - (d:topics ,tm) (d:associations ,tm)) - (union - (elephant:get-instances-by-class 'd:TopicC) - (list-extern-associations))))))) + (if ,tm + (union + (d:topics ,tm) (d:associations ,tm)) + (union + (elephant:get-instances-by-class 'd:TopicC) + (list-extern-associations :revision revision))))))) +

(defun export-xtm (xtm-path &key tm-id @@ -76,9 +90,11 @@ (cxml:with-xml-output (cxml:make-character-stream-sink stream :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)))))))))))

(defun export-xtm-to-string (&key @@ -93,9 +109,13 @@ (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 #'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 #'to-elem-xtm1.0)))))))) + (export-to-elem tm #'(lambda(elem) + (to-elem elem revision))))))))))

(defun export-xtm-fragment (fragment &key (xtm-format '2.0))

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 12:10:37 2010 @@ -12,7 +12,11 @@ (:import-from :constants *XTM2.0-NS* *XTM1.0-NS* - *XTM1.0-XLINK*) + *XTM1.0-XLINK* + *type-psi* + *instance-psi* + *xml-uri* + *xml-string*) (:export :to-elem :to-string :list-extern-associations

Modified: branches/new-datamodel/src/xml/xtm/exporter_xtm2.0.lisp ============================================================================== --- branches/new-datamodel/src/xml/xtm/exporter_xtm2.0.lisp (original) +++ branches/new-datamodel/src/xml/xtm/exporter_xtm2.0.lisp Thu Jun 17 12:10:37 2010 @@ -32,9 +32,11 @@ (cxml:attribute "href" (format nil "#~a" (topic-id topic revision)))))

+ (defgeneric to-elem (instance revision) (:documentation "converts the Topic Maps construct instance to an XTM 2.0 element"))

+ (defmethod to-elem ((psi PersistentIdC) revision) (declare (ignorable revision)) (cxml:with-element "t:subjectIdentifier" @@ -80,7 +82,7 @@ (if (slot-boundp characteristic 'datatype) (datatype characteristic) ""))) - (if (string= characteristic-type "http://www.w3.org/2001/XMLSchema#anyURI") ;-> resourceRef + (if (string= characteristic-type *xml-uri*) ;-> resourceRef (cxml:with-element "t:resourceRef" (let ((ref-topic (when (and (> (length characteristic-value) 0) (eql (elt characteristic-value 0) ##))