[isidorus-cvs] r329 - in trunk/src: . model unit_tests xml/xtm
Lukas Giessmann
lgiessmann at common-lisp.net
Sat Oct 16 13:52:29 UTC 2010
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)))
, at body)))
@@ -54,7 +59,7 @@
(cxml:with-namespace ("xlink" *xtm1.0-xlink*)
(cxml:with-element
"t:topicMap" :empty
- , at body))))
+ , at 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
More information about the Isidorus-cvs
mailing list