Author: lgiessmann Date: Sat Oct 16 09:52:28 2010 New Revision: 329 Log: fixed ticket #63 and ticket #64 --> the xtm 2.0 importer/exporter is able to handle item-identifiers of TopicMap-elements and also to merge TopicMap-elements; added a unit-test for the new functionality Added: trunk/src/unit_tests/poems_light_tm_ii.xtm trunk/src/unit_tests/poems_light_tm_ii_merge.xtm Modified: trunk/src/isidorus.asd trunk/src/model/datamodel.lisp trunk/src/unit_tests/importer_test.lisp trunk/src/unit_tests/unittests-constants.lisp trunk/src/xml/xtm/exporter.lisp trunk/src/xml/xtm/exporter_xtm2.0.lisp trunk/src/xml/xtm/importer_xtm2.0.lisp Modified: trunk/src/isidorus.asd ============================================================================== --- trunk/src/isidorus.asd (original) +++ trunk/src/isidorus.asd Sat Oct 16 09:52:28 2010 @@ -113,6 +113,8 @@ (:static-file "poems.rdf") (:static-file "poems_light.rdf") (:static-file "poems_light.xtm") + (:static-file "poems_light_tm_ii.xtm") + (:static-file "poems_light_tm_ii_merge.xtm") (:static-file "full_mapping.rdf") (:static-file "reification_xtm1.0.xtm") (:static-file "reification_xtm2.0.xtm") Modified: trunk/src/model/datamodel.lisp ============================================================================== --- trunk/src/model/datamodel.lisp (original) +++ trunk/src/model/datamodel.lisp Sat Oct 16 09:52:28 2010 @@ -1177,7 +1177,7 @@ (setf (end-revision last-version) revision))))) -;;; TopicMapconstructC +;;; TopicMapConstructC (defgeneric strictly-equivalent-constructs (construct-1 construct-2 &key revision) (:documentation "Checks if two topic map constructs are not identical but @@ -3487,10 +3487,11 @@ ;;; TopicMapC (defmethod equivalent-constructs ((construct-1 TopicMapC) (construct-2 TopicMapC) &key (revision *TM-REVISION*)) - (declare (integer revision)) - (when (intersection (item-identifiers construct-1 :revision revision) - (item-identifiers construct-2 :revision revision)) - t)) + "In this definition TopicMaps are alwayas equal, + since item-identifiers and reifiers are not changing the result of + the TMDM equality." + (declare (ignorable revision)) + t) (defgeneric TopicMapC-p (class-symbol) Modified: trunk/src/unit_tests/importer_test.lisp ============================================================================== --- trunk/src/unit_tests/importer_test.lisp (original) +++ trunk/src/unit_tests/importer_test.lisp Sat Oct 16 09:52:28 2010 @@ -39,7 +39,8 @@ :test-topic-t100 :test-topicmaps :test-variants - :test-variants-xtm1.0)) + :test-variants-xtm1.0 + :test-merge-topicmaps)) (declaim (optimize (debug 3) (speed 0) (safety 3) (space 0) (compilation-speed 0))) (in-package :importer-test) @@ -683,8 +684,49 @@ tms) :test #'string=))))) - -;as (importer-test:run-importer-tests) +(test test-merge-topicmaps + (let ((dir "data_base") + (tm-id-1 "tm-id-1") + (tm-id-2 "tm-id-2")) + (with-fixture with-empty-db (dir) + (xml-importer:setup-repository *poems_light_tm_ii.xtm* + dir :tm-id tm-id-1) + (xml-importer:import-xtm *poems_light_tm_ii_merge.xtm* + dir :tm-id tm-id-2) + (with-revision 0 + (let ((tm-1 + (d:identified-construct + (first (elephant:get-instances-by-value + 'd:ItemIdentifierC 'd:uri tm-id-1)))) + (tm-2 + (d:identified-construct + (first (elephant:get-instances-by-value + 'd:ItemIdentifierC 'd:uri tm-id-2))))) + (is-true tm-1) + (is-true tm-2) + (is (eql tm-1 tm-2)) + (is-false (set-exclusive-or (map 'list #'d:uri (item-identifiers tm-1)) + (list tm-id-1 tm-id-2 + "http://some.where/poems_light_tm_ii_1" + "http://some.where/poems_light_tm_ii_2") + :test #'string=)) + (is (= (length (d:topics tm-1)) 9)) + (is (= (length (d:associations tm-1)) (+ 1 3))) + (is (= (length (d:in-topicmaps (d:get-item-by-id "schiller"))) 1)) + (is (eql (first (d:in-topicmaps (d:get-item-by-id "schiller"))) tm-1)) + + + (let ((schiller-1 (d:get-item-by-id + "schiller" + :revision (first (last (d:get-all-revisions))))) + (schiller-2 (d:get-item-by-id + "schiller" + :revision (elt (d:get-all-revisions) + (- (length (d:get-all-revisions)) 2))))) + (is-true schiller-1) + (is-false schiller-2))))))) + + (defun run-importer-tests () (run! 'importer-test)) Added: trunk/src/unit_tests/poems_light_tm_ii.xtm ============================================================================== --- (empty file) +++ trunk/src/unit_tests/poems_light_tm_ii.xtm Sat Oct 16 09:52:28 2010 @@ -0,0 +1,69 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!-- ======================================================================= --> +<!-- Isidorus --> +<!-- (c) 2008-2010 Marc Kuester, Christoph Ludwig, Lukas Georgieff --> +<!-- --> +<!-- Isidorus is freely distributable under the LLGPL license. --> +<!-- This ajax module uses the frameworks PrototypeJs and Scriptaculous, --> +<!-- both are distributed under the MIT license. --> +<!-- You can find a detailed description in trunk/docs/LLGPL-LICENSE.txt, --> +<!-- trunk/docs/LGPL-LICENSE.txt and in --> +<!-- trunk/src/ajax/javascripts/external/MIT-LICENSE.txt. --> +<!-- ======================================================================= --> + +<tm:topicMap version="2.0" xmlns:tm="http://www.topicmaps.org/xtm/" + reifier="http://some.where/poems/topicMap-reifier"> + <!-- this file contains constructs that are originally defined as TM and + RDF. So certain constructs are not consistent because of test cases, + but all are valid! --> + <tm:itemIdentity href="http://some.where/poems_light_tm_ii_1"/> + + <tm:itemIdentity href="http://some.where/poems_light_tm_ii_2"/> + + <tm:topic id="topicMap-reifier"> + <tm:itemIdentity href="http://some.where/poems/topicMap-reifier"/> + </tm:topic> + + <tm:topic id="author"> + <tm:subjectIdentifier href="http://some.where/types/Author"/> + </tm:topic> + + <tm:topic id="poem"> + <tm:subjectIdentifier href="http://some.where/types/Poem"/> + </tm:topic> + + <tm:topic id="writer"> + <tm:subjectIdentifier href="http://some.where/roletype/writer"/> + </tm:topic> + + <tm:topic id="written"> + <tm:subjectIdentifier href="http://some.where/roletype/written"/> + </tm:topic> + + <tm:topic id="wrote"> + <tm:subjectIdentifier href="http://some.where/relationship/wrote"/> + </tm:topic> + + <tm:topic id="goethe"> + <tm:subjectIdentifier href="http://some.where/author/Goethe"/> + <tm:instanceOf><tm:topicRef href="#author"/></tm:instanceOf> + </tm:topic> + + <tm:topic id="zauberlehrling"> + <tm:subjectIdentifier href="http://some.where/poem/Der_Zauberlehrling"/> + <tm:itemIdentity href="http://some.where/poem/Zauberlehrling_itemIdentity_1"/> + <tm:instanceOf><tm:topicRef href="#poem"/></tm:instanceOf> + </tm:topic> + + <tm:association> + <tm:type><tm:topicRef href="#wrote"/></tm:type> + <tm:role> + <tm:type><tm:topicRef href="#writer"/></tm:type> + <tm:topicRef href="#goethe"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#written"/></tm:type> + <tm:topicRef href="#zauberlehrling"/> + </tm:role> + </tm:association> +</tm:topicMap> Added: trunk/src/unit_tests/poems_light_tm_ii_merge.xtm ============================================================================== --- (empty file) +++ trunk/src/unit_tests/poems_light_tm_ii_merge.xtm Sat Oct 16 09:52:28 2010 @@ -0,0 +1,28 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!-- ======================================================================= --> +<!-- Isidorus --> +<!-- (c) 2008-2010 Marc Kuester, Christoph Ludwig, Lukas Georgieff --> +<!-- --> +<!-- Isidorus is freely distributable under the LLGPL license. --> +<!-- This ajax module uses the frameworks PrototypeJs and Scriptaculous, --> +<!-- both are distributed under the MIT license. --> +<!-- You can find a detailed description in trunk/docs/LLGPL-LICENSE.txt, --> +<!-- trunk/docs/LGPL-LICENSE.txt and in --> +<!-- trunk/src/ajax/javascripts/external/MIT-LICENSE.txt. --> +<!-- ======================================================================= --> + +<tm:topicMap version="2.0" xmlns:tm="http://www.topicmaps.org/xtm/"> + <!-- this file contains constructs that are originally defined as TM and + RDF. So certain constructs are not consistent because of test cases, + but all are valid! --> + <tm:itemIdentity href="http://some.where/poems_light_tm_ii_1"/> + + <tm:topic id="author"> + <tm:subjectIdentifier href="http://some.where/types/Author"/> + </tm:topic> + + <tm:topic id="schiller"> + <tm:subjectIdentifier href="http://some.where/author/Schiller"/> + <tm:instanceOf><tm:topicRef href="#author"/></tm:instanceOf> + </tm:topic> +</tm:topicMap> Modified: trunk/src/unit_tests/unittests-constants.lisp ============================================================================== --- trunk/src/unit_tests/unittests-constants.lisp (original) +++ trunk/src/unit_tests/unittests-constants.lisp Sat Oct 16 09:52:28 2010 @@ -34,7 +34,9 @@ :*full_mapping.rdf* :*reification_xtm1.0.xtm* :*reification_xtm2.0.xtm* - :*reification.rdf*)) + :*reification.rdf* + :*poems_light_tm_ii.xtm* + :*poems_light_tm_ii_merge.xtm*)) (in-package :unittests-constants) @@ -119,3 +121,13 @@ (defparameter *reification.rdf* (asdf:component-pathname (asdf:find-component *unit-tests-component* "reification.rdf"))) + + +(defparameter *poems_light_tm_ii.xtm* + (asdf:component-pathname + (asdf:find-component *unit-tests-component* "poems_light_tm_ii.xtm"))) + + +(defparameter *poems_light_tm_ii_merge.xtm* + (asdf:component-pathname + (asdf:find-component *unit-tests-component* "poems_light_tm_ii_merge.xtm"))) Modified: trunk/src/xml/xtm/exporter.lisp ============================================================================== --- trunk/src/xml/xtm/exporter.lisp (original) +++ trunk/src/xml/xtm/exporter.lisp Sat Oct 16 09:52:28 2010 @@ -39,12 +39,17 @@ collect item))) -(defmacro with-xtm2.0 (&body body) +(defmacro with-xtm2.0 ((tm revision) &body body) "helper macro to build the Topic Map element" `(cxml:with-namespace ("t" *xtm2.0-ns*) (cxml:with-element "t:topicMap" :empty (cxml:attribute "version" "2.0") + (when ,tm + (to-reifier-elem ,tm ,revision) + (map 'list #'(lambda(x) + (to-elem x ,revision)) + (item-identifiers ,tm :revision ,revision))) ,@body))) @@ -54,7 +59,7 @@ (cxml:with-namespace ("xlink" *xtm1.0-xlink*) (cxml:with-element "t:topicMap" :empty - ,@body)))) + ,@body)))) (defmacro export-to-elem (tm to-elem) @@ -90,7 +95,7 @@ (with-open-file (stream xtm-path :direction :output) (cxml:with-xml-output (cxml:make-character-stream-sink stream :canonical nil) (if (eq xtm-format '2.0) - (with-xtm2.0 + (with-xtm2.0 (tm revision) (export-to-elem tm #'(lambda(elem) (to-elem elem revision)))) (with-xtm1.0 @@ -109,7 +114,7 @@ (with-revision revision (cxml:with-xml-output (cxml:make-string-sink :canonical nil) (if (eq xtm-format '2.0) - (with-xtm2.0 + (with-xtm2.0 (tm revision) (export-to-elem tm #'(lambda(elem) (to-elem elem revision)))) (with-xtm1.0 @@ -123,7 +128,7 @@ (with-revision (revision fragment) (cxml:with-xml-output (cxml:make-string-sink :canonical nil) (if (eq xtm-format '2.0) - (with-xtm2.0 + (with-xtm2.0 (nil nil) (to-elem fragment (revision fragment))) (with-xtm1.0 (to-elem-xtm1.0 fragment (revision fragment)))))))) \ 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 Sat Oct 16 09:52:28 2010 @@ -13,7 +13,7 @@ "Exports the reifier-attribute. The attribute is only exported if the reifier-topic contains at least one item-identifier." - (declare (ReifiableConstructC reifiable-construct) + (declare (type (or ReifiableConstructC nil) reifiable-construct) (type (or integer nil) revision)) (when (and (reifier reifiable-construct :revision revision) (item-identifiers (reifier reifiable-construct :revision revision) Modified: trunk/src/xml/xtm/importer_xtm2.0.lisp ============================================================================== --- trunk/src/xml/xtm/importer_xtm2.0.lisp (original) +++ trunk/src/xml/xtm/importer_xtm2.0.lisp Sat Oct 16 09:52:28 2010 @@ -396,6 +396,7 @@ (xpath-child-elems-by-qname xtm-dom *xtm2.0-ns* "association")) + (defun import-only-topics (xtm-dom &key @@ -417,13 +418,15 @@ (xtm-id d:*current-xtm*) (revision (get-revision))) (declare (dom:element xtm-dom)) - (declare (integer revision)) ;all topics that are imported in one go share the same revision + (declare (integer revision)) + ;all topics/associations that are imported in one go share the same revision (assert elephant:*store-controller*) (with-writer-lock (with-tm (revision xtm-id tm-id) - (let - ((topic-vector (get-topic-elems xtm-dom)) - (assoc-vector (get-association-elems xtm-dom))) + (let ((topic-vector (get-topic-elems xtm-dom)) + (assoc-vector (get-association-elems xtm-dom)) + (tm-ids + (make-identifiers 'ItemIdentifierC xtm-dom "itemIdentity" revision))) (loop for top-elem across topic-vector do (from-topic-elem-to-stub top-elem revision :xtm-id xtm-id)) @@ -436,4 +439,10 @@ (format t "a") (from-association-elem assoc-elem revision :tm tm - :xtm-id xtm-id)))))) + :xtm-id xtm-id)) + (loop for tm-id in tm-ids do + (add-item-identifier tm tm-id :revision revision)) + (let ((reifier-topic (get-reifier-topic xtm-dom revision))) + (when reifier-topic + (add-reifier tm reifier-topic :revision revision))))))) + \ No newline at end of file