- isidorus-cvs@common-lisp.net - mailman3.common-lisp.net

[isidorus-cvs] r469 - in trunk/src: . json/JTM json/isidorus-json xml/rdf xml/xtm
by Lukas Giessmann 10 May '11

10 May '11

Author: lgiessmann Date: Tue May 10 06:56:26 2011 New Revision: 469 Log: xtm-im/exporter | rdf-im/exporter | jtm-im/exporter | isidorus-json-im/exporter: if an untyped name is imported the default-name-type defined by TMDM 7.5 is set. This topic is contained in the file core_psis.xtm and is only imported in the topic map that is created by init-isidorus, i.e. the topic is not added to topics where it is used as name-type. When a name is exported that is typed by the defualt-name-type, the name-type is ignored and the name is exported as untyped name Modified: trunk/src/constants.lisp trunk/src/json/JTM/jtm_exporter.lisp trunk/src/json/JTM/jtm_importer.lisp trunk/src/json/isidorus-json/json_exporter.lisp trunk/src/json/isidorus-json/json_importer.lisp trunk/src/xml/rdf/exporter.lisp trunk/src/xml/rdf/map_to_tm.lisp trunk/src/xml/xtm/exporter_xtm1.0.lisp trunk/src/xml/xtm/exporter_xtm2.0.lisp trunk/src/xml/xtm/importer.lisp trunk/src/xml/xtm/importer_xtm1.0.lisp trunk/src/xml/xtm/importer_xtm2.0.lisp Modified: trunk/src/constants.lisp ============================================================================== --- trunk/src/constants.lisp (original) +++ trunk/src/constants.lisp Tue May 10 06:56:26 2011 @@ -69,7 +69,8 @@ :*tm2rdf-player-property* :*rdf2tm-blank-node-prefix* :*tm2rdf-reifier-property* - :*xsd-ns*)) + :*xsd-ns* + :*topic-name-psi*)) (in-package :constants) @@ -193,4 +194,6 @@ (defparameter *tm2rdf-reifier-property* (concat *tm2rdf-ns* "reifier")) -(defparameter *xsd-ns* "http://www.w3.org/2001/XMLSchema#") \ No newline at end of file +(defparameter *xsd-ns* "http://www.w3.org/2001/XMLSchema#") + +(defparameter *topic-name-psi* "http://psi.topicmaps.org/iso13250/model/topic-name") \ No newline at end of file Modified: trunk/src/json/JTM/jtm_exporter.lisp ============================================================================== --- trunk/src/json/JTM/jtm_exporter.lisp (original) +++ trunk/src/json/JTM/jtm_exporter.lisp Tue May 10 06:56:26 2011 @@ -149,10 +149,14 @@ construct :prefixes prefixes :revision revision) ",")) (value (concat "\"value\":" (json:encode-json-to-string (charvalue construct)) ",")) - (type (concat "\"type\":" - (export-type-to-jtm construct :prefixes prefixes - :error-if-nil nil :revision revision) - ",")) + (type + (concat "\"type\":" + (if (eql (instance-of construct :revision revision) + (get-item-by-psi *topic-name-psi*)) + "null" + (export-type-to-jtm construct :prefixes prefixes + :error-if-nil nil :revision revision)) + ",")) (item-type (when item-type-p (concat "\"item_type\":\"" item_type-name "\","))) (name-parent Modified: trunk/src/json/JTM/jtm_importer.lisp ============================================================================== --- trunk/src/json/JTM/jtm_importer.lisp (original) +++ trunk/src/json/JTM/jtm_importer.lisp Tue May 10 06:56:26 2011 @@ -413,9 +413,11 @@ :charvalue value :themes (get-items-from-jtm-references scope :revision revision :prefixes prefixes) - :instance-of (when type - (get-item-from-jtm-reference - type :revision revision :prefixes prefixes)) + :instance-of (if type + (get-item-from-jtm-reference + type :revision revision :prefixes prefixes) + (get-item-by-psi *topic-name-psi* + :revision revision :error-if-nil t)) :parent (first local-parent) :reifier (when reifier (get-item-from-jtm-reference Modified: trunk/src/json/isidorus-json/json_exporter.lisp ============================================================================== --- trunk/src/json/isidorus-json/json_exporter.lisp (original) +++ trunk/src/json/isidorus-json/json_exporter.lisp Tue May 10 06:56:26 2011 @@ -8,7 +8,7 @@ ;;+----------------------------------------------------------------------------- (defpackage :json-exporter - (:use :cl :json :datamodel :TM-SPARQL :base-tools) + (:use :cl :json :datamodel :TM-SPARQL :base-tools :constants) (:export :export-construct-as-isidorus-json-string :get-all-topic-psis :to-json-string-summary @@ -126,7 +126,10 @@ (identifiers-to-json-string instance :what 'item-identifiers :revision revision))) (type - (type-to-json-string instance :revision revision)) + (if (eql (instance-of instance :revision revision) + (get-item-by-psi *topic-name-psi* :revision revision)) + "\"type\":null" + (type-to-json-string instance :revision revision))) (scope (concat "\"scopes\":" (ref-topics-to-json-string (themes instance :revision revision) Modified: trunk/src/json/isidorus-json/json_importer.lisp ============================================================================== --- trunk/src/json/isidorus-json/json_importer.lisp (original) +++ trunk/src/json/isidorus-json/json_importer.lisp Tue May 10 06:56:26 2011 @@ -8,7 +8,7 @@ ;;+----------------------------------------------------------------------------- (defpackage :json-importer - (:use :cl :json :datamodel :xtm-importer) + (:use :cl :json :datamodel :xtm-importer :constants) (:export :import-from-isidorus-json :*json-xtm*)) @@ -263,13 +263,18 @@ (psis-to-topic (getf json-decoded-list :type) :revision start-revision))) (unless namevalue (error "A name must have exactly one namevalue")) - (let ((name (make-construct 'NameC - :start-revision start-revision - :parent top - :charvalue namevalue - :instance-of instance-of - :item-identifiers item-identifiers - :themes themes))) + (let ((name (make-construct + 'NameC + :start-revision start-revision + :parent top + :charvalue namevalue + :instance-of (if instance-of + instance-of + (get-item-by-psi *topic-name-psi* + :revision start-revision + :error-if-nil t)) + :item-identifiers item-identifiers + :themes themes))) (loop for variant in (getf json-decoded-list :variants) do (json-to-variant variant name start-revision)) name)))) Modified: trunk/src/xml/rdf/exporter.lisp ============================================================================== --- trunk/src/xml/rdf/exporter.lisp (original) +++ trunk/src/xml/rdf/exporter.lisp Tue May 10 06:56:26 2011 @@ -27,6 +27,7 @@ *tm2rdf-variant-type-uri* *tm2rdf-occurrence-type-uri* *tm2rdf-topic-type-uri* + *topic-name-psi* *tm2rdf-association-type-uri* *tm2rdf-role-type-uri* *tm2rdf-reifier-property*) @@ -307,7 +308,9 @@ (make-isi-type *tm2rdf-name-type-uri*) (export-reifier-as-mapping construct) (map 'list #'to-rdf-elem (item-identifiers construct)) - (when (instance-of construct) + (when (and (instance-of construct) + (not (eql (instance-of construct) + (get-item-by-psi *topic-name-psi*)))) (cxml:with-element "isi:nametype" (make-topic-reference (instance-of construct)))) (scopes-to-rdf-elems construct) Modified: trunk/src/xml/rdf/map_to_tm.lisp ============================================================================== --- trunk/src/xml/rdf/map_to_tm.lisp (original) +++ trunk/src/xml/rdf/map_to_tm.lisp Tue May 10 06:56:26 2011 @@ -346,13 +346,19 @@ (elephant:ensure-transaction (:txn-nosync t) (map 'list #'d::delete-construct type-assocs) (map 'list #'d::delete-construct scope-assocs) - (let ((name (make-construct 'NameC - :start-revision start-revision - :parent top - :charvalue value - :instance-of type - :item-identifiers ids - :themes scopes))) + (let ((name + (make-construct 'NameC + :start-revision start-revision + :parent top + :charvalue value + :instance-of (if type + type + (get-item-by-psi + *topic-name-psi* + :revision start-revision + :error-if-nil t)) + :item-identifiers ids + :themes scopes))) (map 'list #'(lambda(variant-topic) (map-isi-variant name variant-topic start-revision)) Modified: trunk/src/xml/xtm/exporter_xtm1.0.lisp ============================================================================== --- trunk/src/xml/xtm/exporter_xtm1.0.lisp (original) +++ trunk/src/xml/xtm/exporter_xtm1.0.lisp Tue May 10 06:56:26 2011 @@ -16,6 +16,7 @@ *type-psi* *instance-psi* *type-instance-psi* + *topic-name-psi* *xml-uri* *xml-string*) (:export :to-elem 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 Tue May 10 06:56:26 2011 @@ -52,7 +52,10 @@ (map 'list #'(lambda(x) (to-elem x revision)) (item-identifiers name :revision revision)) - (when (instance-of name :revision revision) + (when (and (instance-of name :revision revision) + (not (eql (instance-of name :revision revision) + (get-item-by-psi *topic-name-psi* + :revision revision)))) (cxml:with-element "t:type" (ref-to-elem (instance-of name :revision revision) revision))) (when (themes name :revision revision) Modified: trunk/src/xml/xtm/importer.lisp ============================================================================== --- trunk/src/xml/xtm/importer.lisp (original) +++ trunk/src/xml/xtm/importer.lisp Tue May 10 06:56:26 2011 @@ -23,7 +23,8 @@ *XTM1.0-NS* *XTM1.0-XLINK* *XML-STRING* - *XML-URI*) + *XML-URI* + *topic-name-psi*) (:import-from :xml-constants *core_psis.xtm*) (:import-from :xml-tools Modified: trunk/src/xml/xtm/importer_xtm1.0.lisp ============================================================================== --- trunk/src/xml/xtm/importer_xtm1.0.lisp (original) +++ trunk/src/xml/xtm/importer_xtm1.0.lisp Tue May 10 06:56:26 2011 @@ -151,12 +151,15 @@ start-revision :xtm-id xtm-id))) (baseNameString (xpath-fn-string (xpath-single-child-elem-by-qname baseName-elem *xtm1.0-ns* "baseNameString"))) - (reifier-topic (get-reifier-topic-xtm1.0 baseName-elem start-revision))) + (reifier-topic (get-reifier-topic-xtm1.0 baseName-elem start-revision)) + (type (get-item-by-psi *topic-name-psi* :revision start-revision + :error-if-nil t))) (unless baseNameString (error "A baseName must have exactly one baseNameString")) (let ((name (make-construct 'NameC :start-revision start-revision :parent top + :instance-of type :charvalue baseNameString :reifier reifier-topic :themes themes))) 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 Tue May 10 06:56:26 2011 @@ -129,14 +129,19 @@ (reifier-topic (get-reifier-topic name-elem start-revision))) (unless namevalue (error "A name must have exactly one namevalue")) - (let ((name (make-construct 'NameC - :start-revision start-revision - :parent top - :charvalue namevalue - :instance-of instance-of - :item-identifiers item-identifiers - :reifier reifier-topic - :themes themes))) + (let ((name (make-construct + 'NameC + :start-revision start-revision + :parent top + :charvalue namevalue + :instance-of (if instance-of + instance-of + (get-item-by-psi *topic-name-psi* + :revision start-revision + :error-if-nil t)) + :item-identifiers item-identifiers + :reifier reifier-topic + :themes themes))) (loop for variant-elem across (xpath-child-elems-by-qname name-elem *xtm2.0-ns* "variant") do (from-variant-elem variant-elem name start-revision :xtm-id xtm-id)) name)))

1 0

[isidorus-cvs] r468 - trunk/src/xml/xtm
by Lukas Giessmann 10 May '11

10 May '11

Author: lgiessmann Date: Tue May 10 06:30:25 2011 New Revision: 468 Log: core_psis.xtm: added the topic topic-name that is used as default-name-type when no type is specified for a given name Modified: trunk/src/xml/xtm/core_psis.xtm Modified: trunk/src/xml/xtm/core_psis.xtm ============================================================================== --- trunk/src/xml/xtm/core_psis.xtm (original) +++ trunk/src/xml/xtm/core_psis.xtm Tue May 10 06:30:25 2011 @@ -112,4 +112,13 @@ <value>instance</value> </name> </topic> + + <topic id="topic-name"> +  + <subjectIdentifier href="http://psi.topicmaps.org/iso13250/model/topic-name"/> + <name> + <value>topic-name</value> + </name> + </topic> + </topicMap>

1 0

[isidorus-cvs] r467 - in trunk/src: json/JTM unit_tests
by Lukas Giessmann 10 May '11

10 May '11

Author: lgiessmann Date: Tue May 10 06:19:35 2011 New Revision: 467 Log: Fixed ticket #100 => implemented the JTM-im/exporter Modified: trunk/src/json/JTM/jtm_aliases.lisp trunk/src/unit_tests/jtm_test.lisp Modified: trunk/src/json/JTM/jtm_aliases.lisp ============================================================================== --- trunk/src/json/JTM/jtm_aliases.lisp (original) +++ trunk/src/json/JTM/jtm_aliases.lisp Tue May 10 06:19:35 2011 @@ -10,12 +10,9 @@ (defpackage :jtm-exporter (:use :cl :json :datamodel :base-tools :isidorus-threading :constants :exceptions :jtm) - (:export :import-from-jtm - :import-form-jtm-string - :export-as-jtm + (:export :export-as-jtm :export-as-jtm-string :export-construct-as-jtm-string - :*jtm-xtm* :item_type-topicmap :item_type-topic :item_type-name @@ -28,4 +25,12 @@ (defpackage :jtm-importer (:use :cl :json :datamodel :base-tools :isidorus-threading :constants :exceptions :jtm) - (:export :import-from-jtm)) \ No newline at end of file + (:export :import-from-jtm + :import-construct-from-jtm-string + :item_type-topicmap + :item_type-topic + :item_type-name + :item_type-variant + :item_type-occurrence + :item_type-association + :item_type-role)) \ No newline at end of file Modified: trunk/src/unit_tests/jtm_test.lisp ============================================================================== --- trunk/src/unit_tests/jtm_test.lisp (original) +++ trunk/src/unit_tests/jtm_test.lisp Tue May 10 06:19:35 2011 @@ -50,7 +50,10 @@ :test-import-topic-maps-3 :test-import-topic-maps-4 :test-import-topic-maps-5 - :test-import-construct-from-jtm-string)) + :test-import-construct-from-jtm-string + :test-import-from-jtm-1 + :test-import-from-jtm-2 + :test-import-from-jtm-3)) (in-package :jtm-test) @@ -2932,14 +2935,74 @@ (signals exceptions:JTM-error (jtm::import-construct-from-jtm-string jtm-name-1 :revision 100 :jtm-format :1.0))))) - - +(test test-import-from-jtm-1 + "Tests the functionimport-from-jtm." + (with-fixture with-empty-db ("data_base") + (jtm:import-from-jtm + (merge-pathnames + (asdf:component-pathname + (asdf:find-component constants:*isidorus-system* "unit_tests")) + "jtm_1.1_test.jtm") + (merge-pathnames + (asdf:component-pathname constants:*isidorus-system*) + "data_base") + :tm-id "http://some.where/jtm/tm") + (base-tools:open-tm-store + (merge-pathnames + (asdf:component-pathname constants:*isidorus-system*) + "data_base")) + (is (= (length (elephant:get-instances-by-class 'TopicC)) 42)) + (is (= (length (elephant:get-instances-by-class 'AssociationC)) 30)))) + + +(test test-import-from-jtm-2 + "Tests the functionimport-from-jtm." + (with-fixture with-empty-db ("data_base") + (jtm:import-from-jtm + (merge-pathnames + (asdf:component-pathname + (asdf:find-component constants:*isidorus-system* "unit_tests")) + "jtm_1.0_test.jtm") + (merge-pathnames + (asdf:component-pathname constants:*isidorus-system*) + "data_base") + :jtm-format :1.0 + :tm-id "http://some.where/jtm/tm") + (base-tools:open-tm-store + (merge-pathnames + (asdf:component-pathname constants:*isidorus-system*) + "data_base")) + (is (= (length (elephant:get-instances-by-class 'TopicC)) 42)) + (is (= (length (elephant:get-instances-by-class 'AssociationC)) 30)))) -;TODO: -; *import-from-jtm +(test test-import-from-jtm-3 + "Tests the functionimport-from-jtm." + (with-fixture with-empty-db ("data_base") + (let ((jtm-path-2 + (merge-pathnames + (asdf:component-pathname + (asdf:find-component constants:*isidorus-system* "unit_tests")) + "jtm_1.1_test.jtm")) + (jtm-path-1 + (merge-pathnames + (asdf:component-pathname + (asdf:find-component constants:*isidorus-system* "unit_tests")) + "jtm_1.0_test.jtm")) + (db-path + (merge-pathnames + (asdf:component-pathname constants:*isidorus-system*) + "data_base"))) + (signals exceptions::JTM-error + (jtm:import-from-jtm jtm-path-1 db-path :jtm-format :1.1 + :tm-id "http://some.where/tm-id")) + (signals T + (jtm:import-from-jtm jtm-path-1 db-path :jtm-format :1.0)) + (signals exceptions::JTM-error + (jtm:import-from-jtm jtm-path-2 db-path :jtm-format :1.0 + :tm-id "http://some.where/tm-id"))))) (defun run-jtm-tests() "Runs all tests of this test-suite."

1 0

[isidorus-cvs] r466 - trunk/src/unit_tests
by Lukas Giessmann 10 May '11

10 May '11

Author: lgiessmann Date: Tue May 10 05:47:25 2011 New Revision: 466 Log: JTM: added a unit-tests that test the function import-construct-from-jtm-string Modified: trunk/src/unit_tests/jtm_test.lisp Modified: trunk/src/unit_tests/jtm_test.lisp ============================================================================== --- trunk/src/unit_tests/jtm_test.lisp (original) +++ trunk/src/unit_tests/jtm_test.lisp Tue May 10 05:47:25 2011 @@ -49,7 +49,8 @@ :test-import-topic-maps-2 :test-import-topic-maps-3 :test-import-topic-maps-4 - :test-import-topic-maps-5)) + :test-import-topic-maps-5 + :test-import-construct-from-jtm-string)) (in-package :jtm-test) @@ -2874,6 +2875,63 @@ (map 'list #'uri (item-identifiers tm :revision 0)) :test #'string=)) (is (= (length (elephant:get-instances-by-class 'TopicMapC)) 1)))))) + + +(test test-import-construct-from-jtm-string + "Tests the function import-construct-from-jtm-string when importing a name." + (with-fixture with-empty-db ("data_base") + (let* ((jtm-name-1 (concat "{\"version\":\"1.1\",\"prefixes\":{\"pref_1\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#\",\"xsd\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#\",\"pref_2\":\"http:\\/\\/some.where\\/\"},\"item_identifiers\":[\"[pref_2:ii-2]\"],\"value\":\"name-1\",\"type\":\"sl:[pref_2:sl-1]\",\"item_type\":\"name\",\"parent\":[\"si:[pref_2:psi-1]\"],\"scope\":[\"si:[pref_2:psi-1]\"],\"variants\":[{\"item_identifiers\":null,\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"var-1\",\"scope\":[\"sl:[pref_2:sl-1]\"],\"reifier\":null},{\"item_identifiers\":null,\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"var-2\",\"scope\":[\"sl:[pref_2:sl-1]\"],\"reifier\":null}],\"reifier\":\"ii:[pref_2:ii-1]\"}")) + (jtm-name-2 "{\"version\":\"1.0\",\"item_identifiers\":null,\"value\":\"name-2\",\"type\":null,\"item_type\":\"name\",\"parent\":[\"sl:http://some.where/sl-1\"],\"scope\":null,\"variants\":null,\"reifier\":null}") + (jtm-name-3 "{\"version\":\"1.0\",\"item_identifiers\":null,\"value\":\"name-2\",\"type\":null,\"item_type\":\"name\",\"scope\":null,\"variants\":null,\"reifier\":null}") + (type-1 (make-construct + 'TopicC :start-revision 100 + :locators + (list (make-construct 'SubjectLocatorC + :uri "http://some.where/sl-1")))) + (parent-1 (make-construct + 'TopicC :start-revision 100 + :psis + (list (make-construct 'PersistentIdC + :uri "http://some.where/psi-1")))) + (scope-1 parent-1) + (reifier-1 (make-construct + 'TopicC :start-revision 100 + :item-identifiers + (list (make-construct 'ItemIdentifierC + :uri "http://some.where/ii-1")))) + (name-1 (jtm::import-construct-from-jtm-string + jtm-name-1 :revision 100 :jtm-format :1.1)) + (name-2 (jtm::import-construct-from-jtm-string + jtm-name-2 :revision 100 :jtm-format :1.0))) + (is-true (d:find-item-by-revision name-1 100 parent-1)) + (is-false (d:find-item-by-revision name-1 50 parent-1)) + (is (eql (parent name-1 :revision 0) parent-1)) + (is (eql (parent name-2 :revision 0) type-1)) + (is (string= (charvalue name-1) "name-1")) + (is (string= (charvalue name-2) "name-2")) + (is-false (set-exclusive-or + (map 'list #'d:uri (d:item-identifiers name-1 :revision 0)) + (list "http://some.where/ii-2") :test #'string=)) + (is-false (d:item-identifiers name-2 :revision 0)) + (is (eql (reifier name-1 :revision 0) reifier-1)) + (is-false (reifier name-2 :revision 0)) + (is-false (set-exclusive-or (themes name-1 :revision 0) (list scope-1))) + (is-false (themes name-2 :revision 0)) + (is (eql (instance-of name-1 :revision 0) type-1)) + (is-false (instance-of name-2 :revision 0)) + (is-false (set-exclusive-or + (map 'list #'d:charvalue (variants name-1 :revision 0)) + (list "var-1" "var-2") :test #'string=)) + (is-false (variants name-2 :revision 0)) + (signals exceptions:JTM-error + (jtm::import-construct-from-jtm-string + jtm-name-3 :revision 100 :jtm-format :1.0)) + (signals exceptions:JTM-error + (jtm::import-construct-from-jtm-string + jtm-name-2 :revision 100 :jtm-format :1.1)) + (signals exceptions:JTM-error + (jtm::import-construct-from-jtm-string + jtm-name-1 :revision 100 :jtm-format :1.0)))))

1 0

[isidorus-cvs] r465 - in trunk/src: . base-tools json/JTM unit_tests
by Lukas Giessmann 10 May '11

10 May '11

Author: lgiessmann Date: Tue May 10 05:38:24 2011 New Revision: 465 Log: JTM: added unit-tests for importing jtm-strings containing entire topic maps Added: trunk/src/unit_tests/jtm_1.0_test.jtm trunk/src/unit_tests/jtm_1.1_test.jtm Modified: trunk/src/base-tools/base-tools.lisp trunk/src/isidorus.asd trunk/src/json/JTM/jtm_importer.lisp trunk/src/unit_tests/jtm_test.lisp Modified: trunk/src/base-tools/base-tools.lisp ============================================================================== --- trunk/src/base-tools/base-tools.lisp (original) +++ trunk/src/base-tools/base-tools.lisp Tue May 10 05:38:24 2011 @@ -47,7 +47,7 @@ :get-store-spec :open-tm-store :close-tm-store - :read-file)) + :read-file-to-string)) (in-package :base-tools) @@ -587,7 +587,7 @@ (elephant:close-store)) -(defun read-file (file-path) +(defun read-file-to-string (file-path) "A helper function that reads a file and returns the content as a string." (with-open-file (stream file-path) (let ((file-string "")) Modified: trunk/src/isidorus.asd ============================================================================== --- trunk/src/isidorus.asd (original) +++ trunk/src/isidorus.asd Tue May 10 05:38:24 2011 @@ -117,6 +117,8 @@ "json" "threading" "base-tools")) (:module "unit_tests" :components ((:static-file "textgrid.xtm") + (:static-file "jtm_1.0_test.jtm") + (:static-file "jtm_1.1_test.jtm") (:static-file "textgrid_old.xtm") (:static-file "dangling_topicref.xtm") (:static-file "inconsistent.xtm") Modified: trunk/src/json/JTM/jtm_importer.lisp ============================================================================== --- trunk/src/json/JTM/jtm_importer.lisp (original) +++ trunk/src/json/JTM/jtm_importer.lisp Tue May 10 05:38:24 2011 @@ -35,8 +35,9 @@ is a topicmap and it has no item-identifiers defined, a JTM-error is thrown." (declare (String jtm-string) - (type (or Null String) tm-id)) - + (type (or Null String) tm-id) + (Integer revision) + (Keyword jtm-format)) (let* ((jtm-list (json:decode-json-from-string jtm-string)) (version (get-item :VERSION jtm-list)) (item_type (get-item :ITEM--TYPE jtm-list)) @@ -51,7 +52,7 @@ (unless (string= version "1.1") (error (make-condition 'exceptions:JTM-error :message (format nil "From import-construct-from-jtm-string(): the member version must be set to \"1.1\" in JTM version 1.1, but is ~a" version))))) (t - (error (make-condition 'exceptions:JTM-error :message (format nil "From import-construct-from-jtm-string(): only JTM format 1.0 and 1.1 is supported, but found: ~a" jtm-format))))) + (error (make-condition 'exceptions:JTM-error :message (format nil "From import-construct-from-jtm-string(): only JTM format \"1.0\" and \"1.1\" is supported, but found: \"~a\"" jtm-format))))) (cond ((or (not item_type) (string= item_type item_type-topicmap)) (import-topic-map-from-jtm-list @@ -88,7 +89,8 @@ (Keyword jtm-format) (Integer revision)) (open-tm-store repository-path) - (import-construct-from-jtm-string (read-file jtm-path) :tm-id tm-id :revision revision + (import-construct-from-jtm-string (read-file-to-string jtm-path) + :tm-id tm-id :revision revision :jtm-format jtm-format) (close-tm-store)) @@ -105,8 +107,9 @@ (get-item :ITEM--IDENTIFIERS jtm-list) :prefixes prefixes) (when tm-id - (make-construct 'ItemIdentifierC - :uri tm-id))))) + (list + (make-construct 'ItemIdentifierC + :uri tm-id)))))) (unless value (error (make-condition 'JTM-error :message (format nil "From import-topic-map-from-jtm-list(): no topic-map item-identifier is set for ~a" jtm-list)))) value)) @@ -234,6 +237,7 @@ :roles role-lists))) (dolist (tm local-parent) (add-to-tm tm assoc)) + (format t "a") assoc))) @@ -374,6 +378,7 @@ (add-name top name :revision revision)) (dolist (occ top-occs) (add-occurrence top occ :revision revision)) + (format t "t") top)) Added: trunk/src/unit_tests/jtm_1.0_test.jtm ============================================================================== --- (empty file) +++ trunk/src/unit_tests/jtm_1.0_test.jtm Tue May 10 05:38:24 2011 @@ -0,0 +1 @@ +{"version":"1.0","item_identifiers":null,"topics":[{"subject_identifiers":["http:\/\/www.topicmaps.org\/xtm\/1.0\/core.xtm#topic"],"subject_locators":null,"item_identifiers":null,"names":null,"occurrences":null},{"subject_identifiers":["http:\/\/www.topicmaps.org\/xtm\/1.0\/core.xtm#association"],"subject_locators":null,"item_identifiers":null,"names":null,"occurrences":null},{"subject_identifiers":["http:\/\/www.topicmaps.org\/xtm\/1.0\/core.xtm#occurrence"],"subject_locators":null,"item_identifiers":null,"names":null,"occurrences":null},{"subject_identifiers":["http:\/\/www.topicmaps.org\/xtm\/1.0\/core.xtm#class-instance"],"subject_locators":null,"item_identifiers":null,"names":null,"occurrences":null},{"subject_identifiers":["http:\/\/www.topicmaps.org\/xtm\/1.0\/core.xtm#class"],"subject_locators":null,"item_identifiers":null,"names":null,"occurrences":null},{"subject_identifiers":["http:\/\/www.topicmaps.org\/xtm\/1.0\/core.xtm#supertype-subtype"],"subject_locators":null,"item_identifiers":null,"names":null,"occurrences":null},{"subject_identifiers":["http:\/\/www.topicmaps.org\/xtm\/1.0\/core.xtm#supertype"],"subject_locators":null,"item_identifiers":null,"names":null,"occurrences":null},{"subject_identifiers":["http:\/\/www.topicmaps.org\/xtm\/1.0\/core.xtm#subtype"],"subject_locators":null,"item_identifiers":null,"names":null,"occurrences":null},{"subject_identifiers":["http:\/\/www.topicmaps.org\/xtm\/1.0\/core.xtm#sort"],"subject_locators":null,"item_identifiers":null,"names":null,"occurrences":null},{"subject_identifiers":["http:\/\/www.topicmaps.org\/xtm\/1.0\/core.xtm#display"],"subject_locators":null,"item_identifiers":null,"names":null,"occurrences":null},{"subject_identifiers":["http:\/\/psi.topicmaps.org\/iso13250\/model\/type-instance"],"subject_locators":null,"item_identifiers":null,"names":null,"occurrences":null},{"subject_identifiers":["http:\/\/psi.topicmaps.org\/iso13250\/model\/type"],"subject_locators":null,"item_identifiers":null,"names":null,"occurrences":null},{"subject_identifiers":["http:\/\/psi.topicmaps.org\/iso13250\/model\/instance"],"subject_locators":null,"item_identifiers":null,"names":null,"occurrences":null},{"subject_identifiers":["http:\/\/psi.topicmaps.org\/tmcl\/topic-type"],"subject_locators":null,"item_identifiers":null,"names":null,"occurrences":null},{"subject_identifiers":["http:\/\/psi.topicmaps.org\/tmcl\/occurrence-type"],"subject_locators":null,"item_identifiers":null,"names":null,"occurrences":null},{"subject_identifiers":["http:\/\/psi.topicmaps.org\/tmcl\/association-type"],"subject_locators":null,"item_identifiers":null,"names":null,"occurrences":null},{"subject_identifiers":["http:\/\/some.where\/tmsparql\/written-by"],"subject_locators":null,"item_identifiers":null,"names":null,"occurrences":null},{"subject_identifiers":["http:\/\/psi.topicmaps.org\/tmcl\/role-type"],"subject_locators":null,"item_identifiers":null,"names":null,"occurrences":null},{"subject_identifiers":["http:\/\/some.where\/tmsparql\/written"],"subject_locators":null,"item_identifiers":null,"names":null,"occurrences":null},{"subject_identifiers":["http:\/\/some.where\/tmsparql\/writer"],"subject_locators":null,"item_identifiers":null,"names":null,"occurrences":null},{"subject_identifiers":["http:\/\/psi.topicmaps.org\/tmcl\/name-type"],"subject_locators":null,"item_identifiers":null,"names":null,"occurrences":null},{"subject_identifiers":["http:\/\/psi.topicmaps.org\/tmcl\/scope-type"],"subject_locators":null,"item_identifiers":null,"names":null,"occurrences":null},{"subject_identifiers":["http:\/\/some.where\/tmsparql\/author"],"subject_locators":null,"item_identifiers":null,"names":null,"occurrences":null},{"subject_identifiers":["http:\/\/some.where\/tmsparql\/poem"],"subject_locators":null,"item_identifiers":null,"names":null,"occurrences":null},{"subject_identifiers":["http:\/\/some.where\/tmsparql\/first-name"],"subject_locators":null,"item_identifiers":null,"names":null,"occurrences":null},{"subject_identifiers":["http:\/\/some.where\/tmsparql\/last-name"],"subject_locators":null,"item_identifiers":null,"names":null,"occurrences":null},{"subject_identifiers":["http:\/\/some.where\/tmsparql\/title"],"subject_locators":null,"item_identifiers":null,"names":null,"occurrences":null},{"subject_identifiers":["http:\/\/some.where\/tmsparql\/display-name"],"subject_locators":null,"item_identifiers":null,"names":null,"occurrences":null},{"subject_identifiers":["http:\/\/some.where\/tmsparql\/de"],"subject_locators":null,"item_identifiers":null,"names":null,"occurrences":null},{"subject_identifiers":["http:\/\/some.where\/tmsparql\/date-of-birth"],"subject_locators":null,"item_identifiers":null,"names":null,"occurrences":null},{"subject_identifiers":["http:\/\/some.where\/tmsparql\/date-of-death"],"subject_locators":null,"item_identifiers":null,"names":null,"occurrences":null},{"subject_identifiers":["http:\/\/some.where\/tmsparql\/poem-content"],"subject_locators":null,"item_identifiers":null,"names":null,"occurrences":null},{"subject_identifiers":["http:\/\/some.where\/tmsparql\/years"],"subject_locators":null,"item_identifiers":null,"names":null,"occurrences":null},{"subject_identifiers":["http:\/\/some.where\/tmsparql\/isDead"],"subject_locators":null,"item_identifiers":null,"names":null,"occurrences":null},{"subject_identifiers":["http:\/\/some.where\/tmsparql\/isAlive"],"subject_locators":null,"item_identifiers":null,"names":null,"occurrences":null},{"subject_identifiers":["http:\/\/some.where\/tmsparql\/reifier-type"],"subject_locators":null,"item_identifiers":null,"names":null,"occurrences":null},{"subject_identifiers":["http:\/\/some.where\/tmsparql\/author\/goethe"],"subject_locators":null,"item_identifiers":["http:\/\/some.where\/ii\/goethe"],"names":[{"item_identifiers":null,"value":"Johann Wolfgang","type":"si:http:\/\/some.where\/tmsparql\/first-name","scope":null,"variants":null,"reifier":null},{"item_identifiers":null,"value":"von Goethe","type":"si:http:\/\/some.where\/tmsparql\/last-name","scope":null,"variants":[{"item_identifiers":["http:\/\/some.where\/ii\/goethe-variant"],"datatype":"http:\/\/www.w3.org\/2001\/XMLSchema#string","value":"Goethe","scope":["si:http:\/\/some.where\/tmsparql\/display-name"],"reifier":null}],"reifier":"ii:http:\/\/some.where\/ii\/goethe-name-reifier"},{"item_identifiers":["http:\/\/some.where\/ii\/goethe-untyped-name"],"value":"Johann Wolfgang von Goethe","type":null,"scope":null,"variants":null,"reifier":null}],"occurrences":[{"item_identifiers":["http:\/\/some.where\/ii\/goethe-occ"],"datatype":"http:\/\/www.w3.org\/2001\/XMLSchema#date","type":"si:http:\/\/some.where\/tmsparql\/date-of-birth","value":"28.08.1749","scope":null,"reifier":"ii:http:\/\/some.where\/ii\/goethe-occ-reifier"},{"item_identifiers":null,"datatype":"http:\/\/www.w3.org\/2001\/XMLSchema#date","type":"si:http:\/\/some.where\/tmsparql\/date-of-death","value":"22.03.1832","scope":null,"reifier":null},{"item_identifiers":["http:\/\/some.where\/ii\/goethe-years-occ"],"datatype":"http:\/\/www.w3.org\/2001\/XMLSchema#integer","type":"si:http:\/\/some.where\/tmsparql\/years","value":"82","scope":null,"reifier":null},{"item_identifiers":null,"datatype":"http:\/\/www.w3.org\/2001\/XMLSchema#boolean","type":"si:http:\/\/some.where\/tmsparql\/isDead","value":"true","scope":null,"reifier":null},{"item_identifiers":null,"datatype":"http:\/\/www.w3.org\/2001\/XMLSchema#boolean","type":"si:http:\/\/some.where\/tmsparql\/isAlive","value":"false","scope":null,"reifier":null}]},{"subject_identifiers":null,"subject_locators":null,"item_identifiers":["http:\/\/some.where\/ii\/goethe-occ-reifier"],"names":null,"occurrences":null},{"subject_identifiers":null,"subject_locators":null,"item_identifiers":["http:\/\/some.where\/ii\/goethe-name-reifier"],"names":null,"occurrences":null},{"subject_identifiers":["http:\/\/some.where\/psis\/poem\/zauberlehrling"],"subject_locators":null,"item_identifiers":null,"names":[{"item_identifiers":null,"value":"Der Zauberlehrling","type":"si:http:\/\/some.where\/tmsparql\/title","scope":null,"variants":null,"reifier":null}],"occurrences":[{"item_identifiers":["http:\/\/some.where\/ii\/zb\/occurrence"],"datatype":"http:\/\/www.w3.org\/2001\/XMLSchema#string","type":"si:http:\/\/some.where\/tmsparql\/poem-content","value":"Hat der alte Hexenmeister\n\tsich doch einmal wegbegeben!\n\t...","scope":["si:http:\/\/some.where\/tmsparql\/de"],"reifier":null}]},{"subject_identifiers":null,"subject_locators":null,"item_identifiers":["http:\/\/some.where\/ii\/association-reifier"],"names":null,"occurrences":null},{"subject_identifiers":null,"subject_locators":null,"item_identifiers":["http:\/\/some.where\/ii\/role-reifier"],"names":null,"occurrences":null}],"associations":[{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type-instance","reifier":null,"scope":null,"roles":[{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type","reifier":null,"player":"si:http:\/\/psi.topicmaps.org\/tmcl\/topic-type"},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/instance","reifier":null,"player":"si:http:\/\/psi.topicmaps.org\/tmcl\/topic-type"}]},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type-instance","reifier":null,"scope":null,"roles":[{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type","reifier":null,"player":"si:http:\/\/psi.topicmaps.org\/tmcl\/topic-type"},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/instance","reifier":null,"player":"si:http:\/\/psi.topicmaps.org\/tmcl\/occurrence-type"}]},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type-instance","reifier":null,"scope":null,"roles":[{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type","reifier":null,"player":"si:http:\/\/psi.topicmaps.org\/tmcl\/topic-type"},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/instance","reifier":null,"player":"si:http:\/\/psi.topicmaps.org\/tmcl\/association-type"}]},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type-instance","reifier":null,"scope":null,"roles":[{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type","reifier":null,"player":"si:http:\/\/psi.topicmaps.org\/tmcl\/association-type"},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/instance","reifier":null,"player":"si:http:\/\/some.where\/tmsparql\/written-by"}]},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type-instance","reifier":null,"scope":null,"roles":[{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type","reifier":null,"player":"si:http:\/\/psi.topicmaps.org\/tmcl\/topic-type"},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/instance","reifier":null,"player":"si:http:\/\/psi.topicmaps.org\/tmcl\/role-type"}]},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type-instance","reifier":null,"scope":null,"roles":[{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type","reifier":null,"player":"si:http:\/\/psi.topicmaps.org\/tmcl\/role-type"},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/instance","reifier":null,"player":"si:http:\/\/some.where\/tmsparql\/written"}]},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type-instance","reifier":null,"scope":null,"roles":[{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type","reifier":null,"player":"si:http:\/\/psi.topicmaps.org\/tmcl\/role-type"},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/instance","reifier":null,"player":"si:http:\/\/some.where\/tmsparql\/writer"}]},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type-instance","reifier":null,"scope":null,"roles":[{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type","reifier":null,"player":"si:http:\/\/psi.topicmaps.org\/tmcl\/topic-type"},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/instance","reifier":null,"player":"si:http:\/\/psi.topicmaps.org\/tmcl\/name-type"}]},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type-instance","reifier":null,"scope":null,"roles":[{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type","reifier":null,"player":"si:http:\/\/psi.topicmaps.org\/tmcl\/topic-type"},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/instance","reifier":null,"player":"si:http:\/\/psi.topicmaps.org\/tmcl\/scope-type"}]},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type-instance","reifier":null,"scope":null,"roles":[{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type","reifier":null,"player":"si:http:\/\/psi.topicmaps.org\/tmcl\/topic-type"},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/instance","reifier":null,"player":"si:http:\/\/some.where\/tmsparql\/author"}]},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type-instance","reifier":null,"scope":null,"roles":[{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type","reifier":null,"player":"si:http:\/\/psi.topicmaps.org\/tmcl\/topic-type"},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/instance","reifier":null,"player":"si:http:\/\/some.where\/tmsparql\/poem"}]},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type-instance","reifier":null,"scope":null,"roles":[{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type","reifier":null,"player":"si:http:\/\/psi.topicmaps.org\/tmcl\/name-type"},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/instance","reifier":null,"player":"si:http:\/\/some.where\/tmsparql\/first-name"}]},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type-instance","reifier":null,"scope":null,"roles":[{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type","reifier":null,"player":"si:http:\/\/psi.topicmaps.org\/tmcl\/name-type"},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/instance","reifier":null,"player":"si:http:\/\/some.where\/tmsparql\/last-name"}]},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type-instance","reifier":null,"scope":null,"roles":[{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type","reifier":null,"player":"si:http:\/\/psi.topicmaps.org\/tmcl\/name-type"},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/instance","reifier":null,"player":"si:http:\/\/some.where\/tmsparql\/title"}]},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type-instance","reifier":null,"scope":null,"roles":[{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type","reifier":null,"player":"si:http:\/\/psi.topicmaps.org\/tmcl\/scope-type"},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/instance","reifier":null,"player":"si:http:\/\/some.where\/tmsparql\/display-name"}]},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type-instance","reifier":null,"scope":null,"roles":[{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type","reifier":null,"player":"si:http:\/\/psi.topicmaps.org\/tmcl\/scope-type"},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/instance","reifier":null,"player":"si:http:\/\/some.where\/tmsparql\/de"}]},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type-instance","reifier":null,"scope":null,"roles":[{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type","reifier":null,"player":"si:http:\/\/psi.topicmaps.org\/tmcl\/occurrence-type"},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/instance","reifier":null,"player":"si:http:\/\/some.where\/tmsparql\/date-of-birth"}]},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type-instance","reifier":null,"scope":null,"roles":[{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type","reifier":null,"player":"si:http:\/\/psi.topicmaps.org\/tmcl\/occurrence-type"},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/instance","reifier":null,"player":"si:http:\/\/some.where\/tmsparql\/date-of-death"}]},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type-instance","reifier":null,"scope":null,"roles":[{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type","reifier":null,"player":"si:http:\/\/psi.topicmaps.org\/tmcl\/occurrence-type"},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/instance","reifier":null,"player":"si:http:\/\/some.where\/tmsparql\/poem-content"}]},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type-instance","reifier":null,"scope":null,"roles":[{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type","reifier":null,"player":"si:http:\/\/psi.topicmaps.org\/tmcl\/occurrence-type"},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/instance","reifier":null,"player":"si:http:\/\/some.where\/tmsparql\/years"}]},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type-instance","reifier":null,"scope":null,"roles":[{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type","reifier":null,"player":"si:http:\/\/psi.topicmaps.org\/tmcl\/occurrence-type"},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/instance","reifier":null,"player":"si:http:\/\/some.where\/tmsparql\/isDead"}]},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type-instance","reifier":null,"scope":null,"roles":[{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type","reifier":null,"player":"si:http:\/\/psi.topicmaps.org\/tmcl\/occurrence-type"},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/instance","reifier":null,"player":"si:http:\/\/some.where\/tmsparql\/isAlive"}]},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type-instance","reifier":null,"scope":null,"roles":[{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type","reifier":null,"player":"si:http:\/\/psi.topicmaps.org\/tmcl\/topic-type"},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/instance","reifier":null,"player":"si:http:\/\/some.where\/tmsparql\/reifier-type"}]},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type-instance","reifier":null,"scope":null,"roles":[{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type","reifier":null,"player":"si:http:\/\/some.where\/tmsparql\/author"},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/instance","reifier":null,"player":"si:http:\/\/some.where\/tmsparql\/author\/goethe"}]},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type-instance","reifier":null,"scope":null,"roles":[{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type","reifier":null,"player":"si:http:\/\/some.where\/tmsparql\/reifier-type"},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/instance","reifier":null,"player":"ii:http:\/\/some.where\/ii\/goethe-occ-reifier"}]},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type-instance","reifier":null,"scope":null,"roles":[{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type","reifier":null,"player":"si:http:\/\/some.where\/tmsparql\/reifier-type"},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/instance","reifier":null,"player":"ii:http:\/\/some.where\/ii\/goethe-name-reifier"}]},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type-instance","reifier":null,"scope":null,"roles":[{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type","reifier":null,"player":"si:http:\/\/some.where\/tmsparql\/poem"},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/instance","reifier":null,"player":"si:http:\/\/some.where\/psis\/poem\/zauberlehrling"}]},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type-instance","reifier":null,"scope":null,"roles":[{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type","reifier":null,"player":"si:http:\/\/some.where\/tmsparql\/reifier-type"},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/instance","reifier":null,"player":"ii:http:\/\/some.where\/ii\/association-reifier"}]},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type-instance","reifier":null,"scope":null,"roles":[{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/type","reifier":null,"player":"si:http:\/\/some.where\/tmsparql\/reifier-type"},{"item_identifiers":null,"type":"si:http:\/\/psi.topicmaps.org\/iso13250\/model\/instance","reifier":null,"player":"ii:http:\/\/some.where\/ii\/role-reifier"}]},{"item_identifiers":["http:\/\/some.where\/ii\/association"],"type":"si:http:\/\/some.where\/tmsparql\/written-by","reifier":"ii:http:\/\/some.where\/ii\/association-reifier","scope":null,"roles":[{"item_identifiers":null,"type":"si:http:\/\/some.where\/tmsparql\/writer","reifier":"ii:http:\/\/some.where\/ii\/role-reifier","player":"si:http:\/\/some.where\/tmsparql\/author\/goethe"},{"item_identifiers":["http:\/\/some.where\/ii\/role-2"],"type":"si:http:\/\/some.where\/tmsparql\/written","reifier":null,"player":"si:http:\/\/some.where\/psis\/poem\/zauberlehrling"}]}],"item_type":"topicmap","reifier":null} Added: trunk/src/unit_tests/jtm_1.1_test.jtm ============================================================================== --- (empty file) +++ trunk/src/unit_tests/jtm_1.1_test.jtm Tue May 10 05:38:24 2011 @@ -0,0 +1 @@ +{"version":"1.1","prefixes":{"pref_1":"http:\/\/www.topicmaps.org\/xtm\/1.0\/core.xtm#","pref_2":"http:\/\/psi.topicmaps.org\/iso13250\/model\/","pref_5":"http:\/\/some.where\/tmsparql\/author\/","xsd":"http:\/\/www.w3.org\/2001\/XMLSchema#","pref_3":"http:\/\/psi.topicmaps.org\/tmcl\/","pref_6":"http:\/\/some.where\/psis\/poem\/","pref_4":"http:\/\/some.where\/tmsparql\/","pref_7":"http:\/\/some.where\/ii\/zb\/","pref_8":"http:\/\/some.where\/ii\/"},"item_identifiers":["[pref_4:jtm-tm]"],"topics":[{"subject_identifiers":["[pref_1:topic]"],"subject_locators":null,"item_identifiers":null,"instance_of":null,"names":null,"occurrences":null},{"subject_identifiers":["[pref_1:association]"],"subject_locators":null,"item_identifiers":null,"instance_of":null,"names":null,"occurrences":null},{"subject_identifiers":["[pref_1:occurrence]"],"subject_locators":null,"item_identifiers":null,"instance_of":null,"names":null,"occurrences":null},{"subject_identifiers":["[pref_1:class-instance]"],"subject_locators":null,"item_identifiers":null,"instance_of":null,"names":null,"occurrences":null},{"subject_identifiers":["[pref_1:class]"],"subject_locators":null,"item_identifiers":null,"instance_of":null,"names":null,"occurrences":null},{"subject_identifiers":["[pref_1:supertype-subtype]"],"subject_locators":null,"item_identifiers":null,"instance_of":null,"names":null,"occurrences":null},{"subject_identifiers":["[pref_1:supertype]"],"subject_locators":null,"item_identifiers":null,"instance_of":null,"names":null,"occurrences":null},{"subject_identifiers":["[pref_1:subtype]"],"subject_locators":null,"item_identifiers":null,"instance_of":null,"names":null,"occurrences":null},{"subject_identifiers":["[pref_1:sort]"],"subject_locators":null,"item_identifiers":null,"instance_of":null,"names":null,"occurrences":null},{"subject_identifiers":["[pref_1:display]"],"subject_locators":null,"item_identifiers":null,"instance_of":null,"names":null,"occurrences":null},{"subject_identifiers":["[pref_2:type-instance]"],"subject_locators":null,"item_identifiers":null,"instance_of":null,"names":null,"occurrences":null},{"subject_identifiers":["[pref_2:type]"],"subject_locators":null,"item_identifiers":null,"instance_of":null,"names":null,"occurrences":null},{"subject_identifiers":["[pref_2:instance]"],"subject_locators":null,"item_identifiers":null,"instance_of":null,"names":null,"occurrences":null},{"subject_identifiers":["[pref_3:topic-type]"],"subject_locators":null,"item_identifiers":null,"instance_of":["si:[pref_3:topic-type]"],"names":null,"occurrences":null},{"subject_identifiers":["[pref_3:occurrence-type]"],"subject_locators":null,"item_identifiers":null,"instance_of":["si:[pref_3:topic-type]"],"names":null,"occurrences":null},{"subject_identifiers":["[pref_3:association-type]"],"subject_locators":null,"item_identifiers":null,"instance_of":["si:[pref_3:topic-type]"],"names":null,"occurrences":null},{"subject_identifiers":["[pref_4:written-by]"],"subject_locators":null,"item_identifiers":null,"instance_of":["si:[pref_3:association-type]"],"names":null,"occurrences":null},{"subject_identifiers":["[pref_3:role-type]"],"subject_locators":null,"item_identifiers":null,"instance_of":["si:[pref_3:topic-type]"],"names":null,"occurrences":null},{"subject_identifiers":["[pref_4:written]"],"subject_locators":null,"item_identifiers":null,"instance_of":["si:[pref_3:role-type]"],"names":null,"occurrences":null},{"subject_identifiers":["[pref_4:writer]"],"subject_locators":null,"item_identifiers":null,"instance_of":["si:[pref_3:role-type]"],"names":null,"occurrences":null},{"subject_identifiers":["[pref_3:name-type]"],"subject_locators":null,"item_identifiers":null,"instance_of":["si:[pref_3:topic-type]"],"names":null,"occurrences":null},{"subject_identifiers":["[pref_3:scope-type]"],"subject_locators":null,"item_identifiers":null,"instance_of":["si:[pref_3:topic-type]"],"names":null,"occurrences":null},{"subject_identifiers":["[pref_4:author]"],"subject_locators":null,"item_identifiers":null,"instance_of":["si:[pref_3:topic-type]"],"names":null,"occurrences":null},{"subject_identifiers":["[pref_4:poem]"],"subject_locators":null,"item_identifiers":null,"instance_of":["si:[pref_3:topic-type]"],"names":null,"occurrences":null},{"subject_identifiers":["[pref_4:first-name]"],"subject_locators":null,"item_identifiers":null,"instance_of":["si:[pref_3:name-type]"],"names":null,"occurrences":null},{"subject_identifiers":["[pref_4:last-name]"],"subject_locators":null,"item_identifiers":null,"instance_of":["si:[pref_3:name-type]"],"names":null,"occurrences":null},{"subject_identifiers":["[pref_4:title]"],"subject_locators":null,"item_identifiers":null,"instance_of":["si:[pref_3:name-type]"],"names":null,"occurrences":null},{"subject_identifiers":["[pref_4:display-name]"],"subject_locators":null,"item_identifiers":null,"instance_of":["si:[pref_3:scope-type]"],"names":null,"occurrences":null},{"subject_identifiers":["[pref_4:de]"],"subject_locators":null,"item_identifiers":null,"instance_of":["si:[pref_3:scope-type]"],"names":null,"occurrences":null},{"subject_identifiers":["[pref_4:date-of-birth]"],"subject_locators":null,"item_identifiers":null,"instance_of":["si:[pref_3:occurrence-type]"],"names":null,"occurrences":null},{"subject_identifiers":["[pref_4:date-of-death]"],"subject_locators":null,"item_identifiers":null,"instance_of":["si:[pref_3:occurrence-type]"],"names":null,"occurrences":null},{"subject_identifiers":["[pref_4:poem-content]"],"subject_locators":null,"item_identifiers":null,"instance_of":["si:[pref_3:occurrence-type]"],"names":null,"occurrences":null},{"subject_identifiers":["[pref_4:years]"],"subject_locators":null,"item_identifiers":null,"instance_of":["si:[pref_3:occurrence-type]"],"names":null,"occurrences":null},{"subject_identifiers":["[pref_4:isDead]"],"subject_locators":null,"item_identifiers":null,"instance_of":["si:[pref_3:occurrence-type]"],"names":null,"occurrences":null},{"subject_identifiers":["[pref_4:isAlive]"],"subject_locators":null,"item_identifiers":null,"instance_of":["si:[pref_3:occurrence-type]"],"names":null,"occurrences":null},{"subject_identifiers":["[pref_4:reifier-type]"],"subject_locators":null,"item_identifiers":null,"instance_of":["si:[pref_3:topic-type]"],"names":null,"occurrences":null},{"subject_identifiers":["[pref_5:goethe]"],"subject_locators":null,"item_identifiers":["[pref_8:goethe]"],"instance_of":["si:[pref_4:author]"],"names":[{"item_identifiers":null,"value":"Johann Wolfgang","type":"si:[pref_4:first-name]","scope":null,"variants":null,"reifier":null},{"item_identifiers":null,"value":"von Goethe","type":"si:[pref_4:last-name]","scope":null,"variants":[{"item_identifiers":["[pref_8:goethe-variant]"],"datatype":"http:\/\/www.w3.org\/2001\/XMLSchema#string","value":"Goethe","scope":["si:[pref_4:display-name]"],"reifier":null}],"reifier":"ii:[pref_8:goethe-name-reifier]"},{"item_identifiers":["[pref_8:goethe-untyped-name]"],"value":"Johann Wolfgang von Goethe","type":null,"scope":null,"variants":null,"reifier":null}],"occurrences":[{"item_identifiers":["[pref_8:goethe-occ]"],"datatype":"http:\/\/www.w3.org\/2001\/XMLSchema#date","type":"si:[pref_4:date-of-birth]","value":"28.08.1749","scope":null,"reifier":"ii:[pref_8:goethe-occ-reifier]"},{"item_identifiers":null,"datatype":"http:\/\/www.w3.org\/2001\/XMLSchema#date","type":"si:[pref_4:date-of-death]","value":"22.03.1832","scope":null,"reifier":null},{"item_identifiers":["[pref_8:goethe-years-occ]"],"datatype":"http:\/\/www.w3.org\/2001\/XMLSchema#integer","type":"si:[pref_4:years]","value":"82","scope":null,"reifier":null},{"item_identifiers":null,"datatype":"http:\/\/www.w3.org\/2001\/XMLSchema#boolean","type":"si:[pref_4:isDead]","value":"true","scope":null,"reifier":null},{"item_identifiers":null,"datatype":"http:\/\/www.w3.org\/2001\/XMLSchema#boolean","type":"si:[pref_4:isAlive]","value":"false","scope":null,"reifier":null}]},{"subject_identifiers":null,"subject_locators":null,"item_identifiers":["[pref_8:goethe-occ-reifier]"],"instance_of":["si:[pref_4:reifier-type]"],"names":null,"occurrences":null},{"subject_identifiers":null,"subject_locators":null,"item_identifiers":["[pref_8:goethe-name-reifier]"],"instance_of":["si:[pref_4:reifier-type]"],"names":null,"occurrences":null},{"subject_identifiers":["[pref_6:zauberlehrling]"],"subject_locators":null,"item_identifiers":null,"instance_of":["si:[pref_4:poem]"],"names":[{"item_identifiers":null,"value":"Der Zauberlehrling","type":"si:[pref_4:title]","scope":null,"variants":null,"reifier":null}],"occurrences":[{"item_identifiers":["[pref_7:occurrence]"],"datatype":"http:\/\/www.w3.org\/2001\/XMLSchema#string","type":"si:[pref_4:poem-content]","value":"Hat der alte Hexenmeister\n\tsich doch einmal wegbegeben!\n\t...","scope":["si:[pref_4:de]"],"reifier":null}]},{"subject_identifiers":null,"subject_locators":null,"item_identifiers":["[pref_8:association-reifier]"],"instance_of":["si:[pref_4:reifier-type]"],"names":null,"occurrences":null},{"subject_identifiers":null,"subject_locators":null,"item_identifiers":["[pref_8:role-reifier]"],"instance_of":["si:[pref_4:reifier-type]"],"names":null,"occurrences":null}],"associations":[{"item_identifiers":["[pref_8:association]"],"type":"si:[pref_4:written-by]","reifier":"ii:[pref_8:association-reifier]","scope":null,"roles":[{"item_identifiers":null,"type":"si:[pref_4:writer]","reifier":"ii:[pref_8:role-reifier]","player":"si:[pref_5:goethe]"},{"item_identifiers":["[pref_8:role-2]"],"type":"si:[pref_4:written]","reifier":null,"player":"si:[pref_6:zauberlehrling]"}]}],"item_type":"topicmap","reifier":null} Modified: trunk/src/unit_tests/jtm_test.lisp ============================================================================== --- trunk/src/unit_tests/jtm_test.lisp (original) +++ trunk/src/unit_tests/jtm_test.lisp Tue May 10 05:38:24 2011 @@ -44,7 +44,12 @@ :test-import-topics :test-merge-topics :test-import-associations - :test-import-roles)) + :test-import-roles + :test-import-topic-maps-1 + :test-import-topic-maps-2 + :test-import-topic-maps-3 + :test-import-topic-maps-4 + :test-import-topic-maps-5)) (in-package :jtm-test) @@ -1022,10 +1027,10 @@ (export-as-jtm jtm-path-2 :tm-id nil :revision 0 :jtm-format :1.0) (export-as-jtm jtm-path-3 :tm-id fixtures::tm-id :revision 0 :jtm-format :1.1) (export-as-jtm jtm-path-4 :tm-id fixtures::tm-id :revision 0 :jtm-format :1.0) - (let ((jtm-str-1 (read-file jtm-path-1)) - (jtm-str-2 (read-file jtm-path-2)) - (jtm-str-3 (read-file jtm-path-3)) - (jtm-str-4 (read-file jtm-path-4)) + (let ((jtm-str-1 (read-file-to-string jtm-path-1)) + (jtm-str-2 (read-file-to-string jtm-path-2)) + (jtm-str-3 (read-file-to-string jtm-path-3)) + (jtm-str-4 (read-file-to-string jtm-path-4)) (prefixes (list (list :pref "pref_1" :value "http://www.topicmaps.org/xtm/1.0/core.xtm#") @@ -2291,10 +2296,592 @@ (json:decode-json-from-string "{\"version\":\"1.0\",\"item_identifiers\":null,\"type\":null,\"item_type\":\"role\",\"reifier\":null,\"player\":\"ii:http:\\/\\/some.where\\/ii-1\"}") parent-1 :revision 100))))) + +(test test-import-topic-maps-1 + "Tests the function import-topic-map-from-jtm-list." + (with-fixture with-empty-db ("data_base") + (let ((jtm-str + (read-file-to-string + (merge-pathnames + (asdf:component-pathname + (asdf:find-component constants:*isidorus-system* "unit_tests")) + "jtm_1.1_test.jtm")))) + (let ((tm (import-construct-from-jtm-string + jtm-str :revision 100 :jtm-format :1.1))) + (is-true tm) + (is (= (length (elephant:get-instances-by-class 'TopicC)) 42)) + (loop for top in (elephant:get-instances-by-class 'TopicC) do + (cond ((and + (= (length (psis top :revision 0)) 1) + (find + (uri (first (psis top :revision 0))) + (list + "http://www.topicmaps.org/xtm/1.0/core.xtm#topic" + "http://www.topicmaps.org/xtm/1.0/core.xtm#association" + "http://www.topicmaps.org/xtm/1.0/core.xtm#occurrence" + "http://www.topicmaps.org/xtm/1.0/core.xtm#class-instance" + "http://www.topicmaps.org/xtm/1.0/core.xtm#class" + "http://www.topicmaps.org/xtm/1.0/core.xtm#supertype-subtype" + "http://www.topicmaps.org/xtm/1.0/core.xtm#supertype" + "http://www.topicmaps.org/xtm/1.0/core.xtm#subtype" + "http://www.topicmaps.org/xtm/1.0/core.xtm#sort" + "http://www.topicmaps.org/xtm/1.0/core.xtm#display") + :test #'string=)) + (is-false (used-as-theme top :revision 0)) + (is-false (used-as-type top :revision 0)) + (is-false (player-in-roles top :revision 0)) + (is-false (reified-construct top :revision 0)) + (is-false (occurrences top :revision 0)) + (is-false (names top :revision 0)) + (is-false (item-identifiers top :revision 0)) + (is-false (locators top :revision 0)) + (is (= (length (in-topicmaps top :revision 0)) 1)) + (is (eql tm (first (in-topicmaps top :revision 0))))) + ((and + (= (length (psis top :revision 0)) 1) + (find (uri (first (psis top :revision 0))) + (list "http://psi.topicmaps.org/iso13250/model/type-instance" + "http://psi.topicmaps.org/iso13250/model/type" + "http://psi.topicmaps.org/iso13250/model/instance") + :test #'string=)) + (is-false (used-as-theme top :revision 0)) + (is (= (length (used-as-type top :revision 0)) 29)) + (is-false (player-in-roles top :revision 0)) + (is-false (reified-construct top :revision 0)) + (is-false (occurrences top :revision 0)) + (is-false (names top :revision 0)) + (is-false (item-identifiers top :revision 0)) + (is-false (locators top :revision 0)) + (is (= (length (in-topicmaps top :revision 0)) 1)) + (is (eql tm (first (in-topicmaps top :revision 0))))) + ((and + (= (length (psis top :revision 0)) 1) + (find + (uri (first (psis top :revision 0))) + (list + "http://some.where/tmsparql/written-by" + "http://some.where/tmsparql/written" + "http://some.where/tmsparql/writer" + "http://some.where/tmsparql/first-name" + "http://some.where/tmsparql/last-name" + "http://some.where/tmsparql/title" + "http://some.where/tmsparql/date-of-birth" + "http://some.where/tmsparql/date-of-death" + "http://some.where/tmsparql/years" + "http://some.where/tmsparql/isDead" + "http://some.where/tmsparql/isAlive" + "http://some.where/tmsparql/poem-content") + :test 'string=)) + (is-false (used-as-theme top :revision 0)) + (is-true (used-as-type top :revision 0)) + (is (= (length (player-in-roles top :revision 0)) 1)) + (is-false (reified-construct top :revision 0)) + (is-false (occurrences top :revision 0)) + (is-false (names top :revision 0)) + (is-false (item-identifiers top :revision 0)) + (is-false (locators top :revision 0)) + (is (= (length (in-topicmaps top :revision 0)) 1)) + (is (eql tm (first (in-topicmaps top :revision 0))))) + ((and + (= (length (psis top :revision 0)) 1) + (find + (uri (first (psis top :revision 0))) + (list + "http://psi.topicmaps.org/tmcl/topic-type" + "http://psi.topicmaps.org/tmcl/occurrence-type" + "http://psi.topicmaps.org/tmcl/association-type" + "http://psi.topicmaps.org/tmcl/name-type" + "http://psi.topicmaps.org/tmcl/scope-type" + "http://psi.topicmaps.org/tmcl/role-type") + :test #'string=)) + (is-false (used-as-theme top :revision 0)) + (is-false (used-as-type top :revision 0)) + (is-true (player-in-roles top :revision 0)) + (is-false (reified-construct top :revision 0)) + (is-false (occurrences top :revision 0)) + (is-false (names top :revision 0)) + (is-false (item-identifiers top :revision 0)) + (is-false (locators top :revision 0)) + (is (= (length (in-topicmaps top :revision 0)) 1)) + (is (eql tm (first (in-topicmaps top :revision 0))))) + ((or (and + (= (length (psis top :revision 0)) 1) + (find + (uri (first (psis top :revision 0))) + (list + "http://some.where/tmsparql/author/goethe" + "http://some.where/tmsparql/author" + "http://some.where/psis/poem/zauberlehrling" + "http://some.where/tmsparql/poem" + "http://some.where/tmsparql/display-name" + "http://some.where/tmsparql/de" + "http://some.where/tmsparql/reifier-type") + :test #'string=)) + (and + (= (length (item-identifiers top :revision 0)) 1) + (find + (uri (first (item-identifiers top :revision 0))) + (list + "http://some.where/ii/goethe-occ-reifier" + "http://some.where/ii/goethe-name-reifier" + "http://some.where/ii/association-reifier" + "http://some.where/ii/role-reifier") + :test #'string=))) + nil) ;is checked in the next unit-test + (t + (is-false top)))))))) + + + + +(test test-import-topic-maps-2 + "Tests the function import-topic-map-from-jtm-list." + (with-fixture with-empty-db ("data_base") + (let ((jtm-str + (read-file-to-string + (merge-pathnames + (asdf:component-pathname + (asdf:find-component constants:*isidorus-system* "unit_tests")) + "jtm_1.1_test.jtm")))) + (let ((tm (import-construct-from-jtm-string + jtm-str :revision 100 :jtm-format :1.1))) + (is-true tm) + (is (= (length (elephant:get-instances-by-class 'TopicC)) 42)) + (loop for top in (elephant:get-instances-by-class 'TopicC) do + (cond ((and + (= (length (psis top :revision 0)) 1) + (find + (uri (first (psis top :revision 0))) + (list + "http://psi.topicmaps.org/iso13250/model/type-instance" + "http://psi.topicmaps.org/iso13250/model/type" + "http://psi.topicmaps.org/iso13250/model/instance" + "http://www.topicmaps.org/xtm/1.0/core.xtm#topic" + "http://www.topicmaps.org/xtm/1.0/core.xtm#association" + "http://www.topicmaps.org/xtm/1.0/core.xtm#occurrence" + "http://www.topicmaps.org/xtm/1.0/core.xtm#class-instance" + "http://www.topicmaps.org/xtm/1.0/core.xtm#class" + "http://www.topicmaps.org/xtm/1.0/core.xtm#supertype-subtype" + "http://www.topicmaps.org/xtm/1.0/core.xtm#supertype" + "http://www.topicmaps.org/xtm/1.0/core.xtm#subtype" + "http://www.topicmaps.org/xtm/1.0/core.xtm#sort" + "http://www.topicmaps.org/xtm/1.0/core.xtm#display" + "http://some.where/tmsparql/written-by" + "http://some.where/tmsparql/written" + "http://some.where/tmsparql/writer" + "http://some.where/tmsparql/first-name" + "http://some.where/tmsparql/last-name" + "http://some.where/tmsparql/title" + "http://some.where/tmsparql/date-of-birth" + "http://some.where/tmsparql/date-of-death" + "http://some.where/tmsparql/years" + "http://some.where/tmsparql/isDead" + "http://some.where/tmsparql/isAlive" + "http://some.where/tmsparql/poem-content" + "http://psi.topicmaps.org/tmcl/topic-type" + "http://psi.topicmaps.org/tmcl/occurrence-type" + "http://psi.topicmaps.org/tmcl/association-type" + "http://psi.topicmaps.org/tmcl/name-type" + "http://psi.topicmaps.org/tmcl/scope-type" + "http://psi.topicmaps.org/tmcl/role-type") + :test #'string=)) + nil) ;is checked in the unit-test before + ((and + (= (length (psis top :revision 0)) 1) + (find + (uri (first (psis top :revision 0))) + (list + "http://some.where/tmsparql/author" + "http://some.where/tmsparql/poem" + "http://some.where/tmsparql/display-name" + "http://some.where/tmsparql/de" + "http://some.where/tmsparql/reifier-type") + :test #'string=)) + (is-false (reified-construct top :revision 0)) + (is-false (occurrences top :revision 0)) + (is-false (names top :revision 0)) + (is-false (item-identifiers top :revision 0)) + (is-false (locators top :revision 0)) + (is (= (length (in-topicmaps top :revision 0)) 1)) + (is (eql tm (first (in-topicmaps top :revision 0))))) + ((and + (= (length (item-identifiers top :revision 0)) 1) + (find + (uri (first (item-identifiers top :revision 0))) + (list + "http://some.where/ii/goethe-occ-reifier" + "http://some.where/ii/goethe-name-reifier" + "http://some.where/ii/association-reifier" + "http://some.where/ii/role-reifier") + :test #'string=)) + (is-false (used-as-theme top :revision 0)) + (is-false (used-as-type top :revision 0)) + (is-true (player-in-roles top :revision 0)) + (is-true (reified-construct top :revision 0)) + (is-false (occurrences top :revision 0)) + (is-false (names top :revision 0)) + (is-false (psis top :revision 0)) + (is-false (locators top :revision 0)) + (is (= (length (in-topicmaps top :revision 0)) 1)) + (is (eql tm (first (in-topicmaps top :revision 0))))) + ((and (= (length (psis top :revision 0)) 1) + (string= (uri (first (psis top :revision 0))) + "http://some.where/tmsparql/author/goethe")) + (is-false (used-as-theme top :revision 0)) + (is-false (used-as-type top :revision 0)) + (is-true (player-in-roles top :revision 0)) + (is-false (reified-construct top :revision 0)) + (is (= (length (occurrences top :revision 0)) 5)) + (is (= (length (names top :revision 0)) 3)) + (is (= (length (item-identifiers top :revision 0)) 1)) + (is (string= + "http://some.where/ii/goethe" + (uri (first (item-identifiers top :revision 0))))) + (is-false (locators top :revision 0)) + (is (= (length (in-topicmaps top :revision 0)) 1)) + (is (eql tm (first (in-topicmaps top :revision 0))))) + ((and (= (length (psis top :revision 0)) 1) + (string= (uri (first (psis top :revision 0))) + "http://some.where/psis/poem/zauberlehrling")) + (is-false (used-as-theme top :revision 0)) + (is-false (used-as-type top :revision 0)) + (is-true (player-in-roles top :revision 0)) + (is-false (reified-construct top :revision 0)) + (is (= (length (occurrences top :revision 0)) 1)) + (is (= (length (names top :revision 0)) 1)) + (is-false (item-identifiers top :revision 0)) + (is-false (locators top :revision 0)) + (is (= (length (in-topicmaps top :revision 0)) 1)) + (is (eql tm (first (in-topicmaps top :revision 0))))) + (t + (is-false top)))) + (is (= (length (elephant:get-instances-by-class 'TopicMapC)) 1)) + (is (= (length (elephant:get-instances-by-class 'AssociationC)) 30)) + (let ((assoc + (get-item-by-item-identifier "http://some.where/ii/association" + :revision 0))) + (is (typep assoc 'AssociationC)) + (is (= (length (roles assoc :revision 0)) 2)) + (is (= (length (item-identifiers assoc :revision 0)) 1)) + (is (eql (instance-of assoc :revision 0) + (get-item-by-psi "http://some.where/tmsparql/written-by" + :revision 0))) + (is (eql (reifier assoc :revision 0) + (get-item-by-item-identifier + "http://some.where/ii/association-reifier" + :revision 0)))))))) + + +(test test-import-topic-maps-3 + "Tests the function import-topic-map-from-jtm-list." + (with-fixture with-empty-db ("data_base") + (let* ((jtm-str + (read-file-to-string + (merge-pathnames + (asdf:component-pathname + (asdf:find-component constants:*isidorus-system* "unit_tests")) + "jtm_1.0_test.jtm"))) + (tm (import-construct-from-jtm-string + jtm-str :revision 100 :jtm-format :1.0 + :tm-id "http://some.where/jtm-tm"))) + (is-true tm) + (is (= (length (elephant:get-instances-by-class 'TopicC)) 42)) + (loop for top in (elephant:get-instances-by-class 'TopicC) do + (cond ((and + (= (length (psis top :revision 0)) 1) + (find + (uri (first (psis top :revision 0))) + (list + "http://www.topicmaps.org/xtm/1.0/core.xtm#topic" + "http://www.topicmaps.org/xtm/1.0/core.xtm#association" + "http://www.topicmaps.org/xtm/1.0/core.xtm#occurrence" + "http://www.topicmaps.org/xtm/1.0/core.xtm#class-instance" + "http://www.topicmaps.org/xtm/1.0/core.xtm#class" + "http://www.topicmaps.org/xtm/1.0/core.xtm#supertype-subtype" + "http://www.topicmaps.org/xtm/1.0/core.xtm#supertype" + "http://www.topicmaps.org/xtm/1.0/core.xtm#subtype" + "http://www.topicmaps.org/xtm/1.0/core.xtm#sort" + "http://www.topicmaps.org/xtm/1.0/core.xtm#display") + :test #'string=)) + (is-false (used-as-theme top :revision 0)) + (is-false (used-as-type top :revision 0)) + (is-false (player-in-roles top :revision 0)) + (is-false (reified-construct top :revision 0)) + (is-false (occurrences top :revision 0)) + (is-false (names top :revision 0)) + (is-false (item-identifiers top :revision 0)) + (is-false (locators top :revision 0)) + (is (= (length (in-topicmaps top :revision 0)) 1)) + (is (eql tm (first (in-topicmaps top :revision 0))))) + ((and + (= (length (psis top :revision 0)) 1) + (find (uri (first (psis top :revision 0))) + (list "http://psi.topicmaps.org/iso13250/model/type-instance" + "http://psi.topicmaps.org/iso13250/model/type" + "http://psi.topicmaps.org/iso13250/model/instance") + :test #'string=)) + (is-false (used-as-theme top :revision 0)) + (is (= (length (used-as-type top :revision 0)) 29)) + (is-false (player-in-roles top :revision 0)) + (is-false (reified-construct top :revision 0)) + (is-false (occurrences top :revision 0)) + (is-false (names top :revision 0)) + (is-false (item-identifiers top :revision 0)) + (is-false (locators top :revision 0)) + (is (= (length (in-topicmaps top :revision 0)) 1)) + (is (eql tm (first (in-topicmaps top :revision 0))))) + ((and + (= (length (psis top :revision 0)) 1) + (find + (uri (first (psis top :revision 0))) + (list + "http://some.where/tmsparql/written-by" + "http://some.where/tmsparql/written" + "http://some.where/tmsparql/writer" + "http://some.where/tmsparql/first-name" + "http://some.where/tmsparql/last-name" + "http://some.where/tmsparql/title" + "http://some.where/tmsparql/date-of-birth" + "http://some.where/tmsparql/date-of-death" + "http://some.where/tmsparql/years" + "http://some.where/tmsparql/isDead" + "http://some.where/tmsparql/isAlive" + "http://some.where/tmsparql/poem-content") + :test 'string=)) + (is-false (used-as-theme top :revision 0)) + (is-true (used-as-type top :revision 0)) + (is (= (length (player-in-roles top :revision 0)) 1)) + (is-false (reified-construct top :revision 0)) + (is-false (occurrences top :revision 0)) + (is-false (names top :revision 0)) + (is-false (item-identifiers top :revision 0)) + (is-false (locators top :revision 0)) + (is (= (length (in-topicmaps top :revision 0)) 1)) + (is (eql tm (first (in-topicmaps top :revision 0))))) + ((and + (= (length (psis top :revision 0)) 1) + (find + (uri (first (psis top :revision 0))) + (list + "http://psi.topicmaps.org/tmcl/topic-type" + "http://psi.topicmaps.org/tmcl/occurrence-type" + "http://psi.topicmaps.org/tmcl/association-type" + "http://psi.topicmaps.org/tmcl/name-type" + "http://psi.topicmaps.org/tmcl/scope-type" + "http://psi.topicmaps.org/tmcl/role-type") + :test #'string=)) + (is-false (used-as-theme top :revision 0)) + (is-false (used-as-type top :revision 0)) + (is-true (player-in-roles top :revision 0)) + (is-false (reified-construct top :revision 0)) + (is-false (occurrences top :revision 0)) + (is-false (names top :revision 0)) + (is-false (item-identifiers top :revision 0)) + (is-false (locators top :revision 0)) + (is (= (length (in-topicmaps top :revision 0)) 1)) + (is (eql tm (first (in-topicmaps top :revision 0))))) + ((or (and + (= (length (psis top :revision 0)) 1) + (find + (uri (first (psis top :revision 0))) + (list + "http://some.where/tmsparql/author/goethe" + "http://some.where/tmsparql/author" + "http://some.where/psis/poem/zauberlehrling" + "http://some.where/tmsparql/poem" + "http://some.where/tmsparql/display-name" + "http://some.where/tmsparql/de" + "http://some.where/tmsparql/reifier-type") + :test #'string=)) + (and + (= (length (item-identifiers top :revision 0)) 1) + (find + (uri (first (item-identifiers top :revision 0))) + (list + "http://some.where/ii/goethe-occ-reifier" + "http://some.where/ii/goethe-name-reifier" + "http://some.where/ii/association-reifier" + "http://some.where/ii/role-reifier") + :test #'string=))) + nil) ;is checked in the next unit-test + (t + (is-false top))))))) + + +(test test-import-topic-maps-4 + "Tests the function import-topic-map-from-jtm-list." + (with-fixture with-empty-db ("data_base") + (let* ((jtm-str + (read-file-to-string + (merge-pathnames + (asdf:component-pathname + (asdf:find-component constants:*isidorus-system* "unit_tests")) + "jtm_1.0_test.jtm"))) + (tm (import-construct-from-jtm-string + jtm-str :revision 100 :jtm-format :1.0 + :tm-id "http://some.where/jtm-tm"))) + (is-true tm) + (is (= (length (elephant:get-instances-by-class 'TopicC)) 42)) + (loop for top in (elephant:get-instances-by-class 'TopicC) do + (cond ((and + (= (length (psis top :revision 0)) 1) + (find + (uri (first (psis top :revision 0))) + (list + "http://psi.topicmaps.org/iso13250/model/type-instance" + "http://psi.topicmaps.org/iso13250/model/type" + "http://psi.topicmaps.org/iso13250/model/instance" + "http://www.topicmaps.org/xtm/1.0/core.xtm#topic" + "http://www.topicmaps.org/xtm/1.0/core.xtm#association" + "http://www.topicmaps.org/xtm/1.0/core.xtm#occurrence" + "http://www.topicmaps.org/xtm/1.0/core.xtm#class-instance" + "http://www.topicmaps.org/xtm/1.0/core.xtm#class" + "http://www.topicmaps.org/xtm/1.0/core.xtm#supertype-subtype" + "http://www.topicmaps.org/xtm/1.0/core.xtm#supertype" + "http://www.topicmaps.org/xtm/1.0/core.xtm#subtype" + "http://www.topicmaps.org/xtm/1.0/core.xtm#sort" + "http://www.topicmaps.org/xtm/1.0/core.xtm#display" + "http://some.where/tmsparql/written-by" + "http://some.where/tmsparql/written" + "http://some.where/tmsparql/writer" + "http://some.where/tmsparql/first-name" + "http://some.where/tmsparql/last-name" + "http://some.where/tmsparql/title" + "http://some.where/tmsparql/date-of-birth" + "http://some.where/tmsparql/date-of-death" + "http://some.where/tmsparql/years" + "http://some.where/tmsparql/isDead" + "http://some.where/tmsparql/isAlive" + "http://some.where/tmsparql/poem-content" + "http://psi.topicmaps.org/tmcl/topic-type" + "http://psi.topicmaps.org/tmcl/occurrence-type" + "http://psi.topicmaps.org/tmcl/association-type" + "http://psi.topicmaps.org/tmcl/name-type" + "http://psi.topicmaps.org/tmcl/scope-type" + "http://psi.topicmaps.org/tmcl/role-type") + :test #'string=)) + nil) ;is checked in the unit-test before + ((and + (= (length (psis top :revision 0)) 1) + (find + (uri (first (psis top :revision 0))) + (list + "http://some.where/tmsparql/author" + "http://some.where/tmsparql/poem" + "http://some.where/tmsparql/display-name" + "http://some.where/tmsparql/de" + "http://some.where/tmsparql/reifier-type") + :test #'string=)) + (is-false (reified-construct top :revision 0)) + (is-false (occurrences top :revision 0)) + (is-false (names top :revision 0)) + (is-false (item-identifiers top :revision 0)) + (is-false (locators top :revision 0)) + (is (= (length (in-topicmaps top :revision 0)) 1)) + (is (eql tm (first (in-topicmaps top :revision 0))))) + ((and + (= (length (item-identifiers top :revision 0)) 1) + (find + (uri (first (item-identifiers top :revision 0))) + (list + "http://some.where/ii/goethe-occ-reifier" + "http://some.where/ii/goethe-name-reifier" + "http://some.where/ii/association-reifier" + "http://some.where/ii/role-reifier") + :test #'string=)) + (is-false (used-as-theme top :revision 0)) + (is-false (used-as-type top :revision 0)) + (is-true (player-in-roles top :revision 0)) + (is-true (reified-construct top :revision 0)) + (is-false (occurrences top :revision 0)) + (is-false (names top :revision 0)) + (is-false (psis top :revision 0)) + (is-false (locators top :revision 0)) + (is (= (length (in-topicmaps top :revision 0)) 1)) + (is (eql tm (first (in-topicmaps top :revision 0))))) + ((and (= (length (psis top :revision 0)) 1) + (string= (uri (first (psis top :revision 0))) + "http://some.where/tmsparql/author/goethe")) + (is-false (used-as-theme top :revision 0)) + (is-false (used-as-type top :revision 0)) + (is-true (player-in-roles top :revision 0)) + (is-false (reified-construct top :revision 0)) + (is (= (length (occurrences top :revision 0)) 5)) + (is (= (length (names top :revision 0)) 3)) + (is (= (length (item-identifiers top :revision 0)) 1)) + (is (string= + "http://some.where/ii/goethe" + (uri (first (item-identifiers top :revision 0))))) + (is-false (locators top :revision 0)) + (is (= (length (in-topicmaps top :revision 0)) 1)) + (is (eql tm (first (in-topicmaps top :revision 0))))) + ((and (= (length (psis top :revision 0)) 1) + (string= (uri (first (psis top :revision 0))) + "http://some.where/psis/poem/zauberlehrling")) + (is-false (used-as-theme top :revision 0)) + (is-false (used-as-type top :revision 0)) + (is-true (player-in-roles top :revision 0)) + (is-false (reified-construct top :revision 0)) + (is (= (length (occurrences top :revision 0)) 1)) + (is (= (length (names top :revision 0)) 1)) + (is-false (item-identifiers top :revision 0)) + (is-false (locators top :revision 0)) + (is (= (length (in-topicmaps top :revision 0)) 1)) + (is (eql tm (first (in-topicmaps top :revision 0))))) + (t + (is-false top)))) + (is (= (length (elephant:get-instances-by-class 'AssociationC)) 30)) + (let ((assoc + (get-item-by-item-identifier "http://some.where/ii/association" + :revision 0))) + (is (= (length (elephant:get-instances-by-class 'TopicMapC)) 1)) + (is (typep assoc 'AssociationC)) + (is (= (length (roles assoc :revision 0)) 2)) + (is (= (length (item-identifiers assoc :revision 0)) 1)) + (is (eql (instance-of assoc :revision 0) + (get-item-by-psi "http://some.where/tmsparql/written-by" + :revision 0))) + (is (eql (reifier assoc :revision 0) + (get-item-by-item-identifier + "http://some.where/ii/association-reifier" + :revision 0))))))) + + +(test test-import-topic-maps-5 + "Tests the function import-topic-map-from-jtm-list." + (with-fixture with-empty-db ("data_base") + (let* ((jtm-str-1 + (read-file-to-string + (merge-pathnames + (asdf:component-pathname + (asdf:find-component constants:*isidorus-system* "unit_tests")) + "jtm_1.0_test.jtm"))) + (jtm-str-2 + (read-file-to-string + (merge-pathnames + (asdf:component-pathname + (asdf:find-component constants:*isidorus-system* "unit_tests")) + "jtm_1.1_test.jtm")))) + (signals exceptions::JTM-error + (import-construct-from-jtm-string + jtm-str-1 :revision 100 :jtm-format :1.1)) + (let ((tm (import-construct-from-jtm-string + jtm-str-2 :revision 100 :jtm-format :1.1 + :tm-id "http://some.where/new-tm-id"))) + (is-false (set-exclusive-or + (list "http://some.where/new-tm-id" + "http://some.where/tmsparql/jtm-tm") + (map 'list #'uri (item-identifiers tm :revision 0)) + :test #'string=)) + (is (= (length (elephant:get-instances-by-class 'TopicMapC)) 1)))))) + + + + + + ;TODO: -; *import-construct-from-jtm-string ; *import-from-jtm -; *import-topic-map-from-jtm-list (defun run-jtm-tests() "Runs all tests of this test-suite."

1 0

[isidorus-cvs] r464 - in trunk/src: json/JTM unit_tests
by Lukas Giessmann 09 May '11

09 May '11

Author: lgiessmann Date: Mon May 9 10:39:34 2011 New Revision: 464 Log: JTM: added unit-tests for importing JTM-roles => fixed a bug in referencing role-parents Modified: trunk/src/json/JTM/jtm_importer.lisp trunk/src/unit_tests/jtm_test.lisp Modified: trunk/src/json/JTM/jtm_importer.lisp ============================================================================== --- trunk/src/json/JTM/jtm_importer.lisp (original) +++ trunk/src/json/JTM/jtm_importer.lisp Mon May 9 10:39:34 2011 @@ -144,13 +144,13 @@ (type (get-item :TYPE jtm-list)) (reifier (get-item :REIFIER jtm-list)) (player (get-item :PLAYER jtm-list)) - (parent-reference (get-item :PARENT jtm-list)) + (parent-references (get-item :PARENT jtm-list)) (local-parent (if parent - parent - (when parent-reference - (get-item-from-jtm-reference - parent-reference :revision revision :prefixes prefixes))))) + (list parent) + (when parent-references + (get-items-from-jtm-references + parent-references :revision revision :prefixes prefixes))))) (unless local-parent (error (make-condition 'JTM-error :message (format nil "From import-role-from-jtm-list(): the JTM role ~a must have exactly one parent set in its members." jtm-list)))) (unless type @@ -166,7 +166,7 @@ type :revision revision :prefixes prefixes) :player (get-item-from-jtm-reference player :revision revision :prefixes prefixes) - :parent local-parent))) + :parent (first local-parent)))) (defun make-plist-of-jtm-role(jtm-list &key (revision *TM-REVISION*) prefixes) Modified: trunk/src/unit_tests/jtm_test.lisp ============================================================================== --- trunk/src/unit_tests/jtm_test.lisp (original) +++ trunk/src/unit_tests/jtm_test.lisp Mon May 9 10:39:34 2011 @@ -43,7 +43,8 @@ :test-make-instance-of-association :test-import-topics :test-merge-topics - :test-import-associations)) + :test-import-associations + :test-import-roles)) (in-package :jtm-test) @@ -2200,9 +2201,97 @@ nil :revision 100))))) +(test test-import-roles + "Tests the function import-role-from-jtm-list." + (with-fixture with-empty-db ("data_base") + (let* ((prefixes (list (list :pref "xsd" :value *xsd-ns*) + (list :pref "pref_1" :value "http://some.where/"))) + (jtm-role-1 "{\"version\":\"1.1\",\"prefixes\":{\"xsd\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#\",\"pref_1\":\"http:\\/\\/some.where\\/\"},\"item_identifiers\":[\"[pref_1:ii-3]\",\"[pref_1:ii-4]\"],\"type\":\"sl:[pref_1:sl-1]\",\"item_type\":\"role\",\"parent\":[\"ii:[pref_1:ii-2]\"],\"reifier\":\"sl:[pref_1:sl-2]\",\"player\":\"si:[pref_1:psi-1]\"}") + (jtm-role-2 "{\"version\":\"1.0\",\"item_identifiers\":null,\"type\":\"ii:http:\\/\\/some.where\\/ii-1\",\"item_type\":\"role\",\"reifier\":null,\"player\":\"sl:http:\\/\\/some.where\\/sl-1\"}") + (type-1 (make-construct + 'TopicC :start-revision 100 + :locators + (list (make-construct 'SubjectLocatorC + :uri "http://some.where/sl-1")))) + (reifier-1 (make-construct + 'TopicC :start-revision 100 + :locators + (list (make-construct 'SubjectLocatorC + :uri "http://some.where/sl-2")))) + (parent-1 (make-construct + 'AssociationC :start-revision 100 + :item-identifiers + (list (make-construct 'ItemIdentifierC + :uri "http://some.where/ii-2")))) + (player-1 (make-construct + 'TopicC :start-revision 100 + :psis + (list (make-construct 'PersistentIdC + :uri "http://some.where/psi-1")))) + (type-2 (make-construct + 'TopicC :start-revision 100 + :item-identifiers + (list (make-construct 'ItemIdentifierC + :uri "http://some.where/ii-1")))) + (player-2 type-1) + (role-1 (jtm::import-role-from-jtm-list + (json:decode-json-from-string jtm-role-1) + nil :revision 100 :prefixes prefixes)) + (role-2 (jtm::import-role-from-jtm-list + (json:decode-json-from-string jtm-role-2) + parent-1 :revision 100))) + (is (= (length (elephant:get-instances-by-class 'AssociationC)) 1)) + (is (= (length (elephant:get-instances-by-class 'RoleC)) 2)) + (is (= (length (roles parent-1 :revision 0)) 2)) + (map 'list #'(lambda(role) + (is (eql (parent role :revision 0) parent-1))) + (elephant:get-instances-by-class 'RoleC)) + (is-true (find-if #'(lambda(role) + (and + (eql (instance-of role :revision 0) type-1) + (eql (player role :revision 0) player-1) + (eql (reifier role :revision 0) reifier-1) + (= (length (item-identifiers role :revision 0)) 2) + (or (string= + (uri (first (item-identifiers role :revision 0))) + "http://some.where/ii-3") + (string= + (uri (second (item-identifiers role :revision 0))) + "http://some.where/ii-3")) + (or (string= + (uri (first (item-identifiers role :revision 0))) + "http://some.where/ii-4") + (string= + (uri (second (item-identifiers role :revision 0))) + "http://some.where/ii-4")))) + (roles parent-1 :revision 0))) + (is-true (find-if #'(lambda(role) + (and + (eql (instance-of role :revision 0) type-2) + (eql (player role :revision 0) player-2) + (not (reifier role :revision 0)) + (not (item-identifiers role :revision 0)))) + (roles parent-1 :revision 0))) + (is-true (find role-1 (roles parent-1 :revision 0))) + (is-true (find role-2 (roles parent-1 :revision 0))) + (signals exceptions::JTM-error + (jtm::import-role-from-jtm-list + (json:decode-json-from-string jtm-role-1) + nil :revision 100)) + (signals exceptions::JTM-error + (jtm::import-role-from-jtm-list + (json:decode-json-from-string jtm-role-2) + nil :revision 100)) + (signals exceptions::JTM-error + (jtm::import-role-from-jtm-list + (json:decode-json-from-string "{\"version\":\"1.0\",\"item_identifiers\":null,\"type\":\"ii:http:\\/\\/some.where\\/ii-1\",\"item_type\":\"role\",\"reifier\":null,\"player\":null}") + parent-1 :revision 100)) + (signals exceptions::JTM-error + (jtm::import-role-from-jtm-list + (json:decode-json-from-string "{\"version\":\"1.0\",\"item_identifiers\":null,\"type\":null,\"item_type\":\"role\",\"reifier\":null,\"player\":\"ii:http:\\/\\/some.where\\/ii-1\"}") + parent-1 :revision 100))))) ;TODO: -; *import-role-from-jtm-list ; *import-construct-from-jtm-string ; *import-from-jtm ; *import-topic-map-from-jtm-list

1 0

[isidorus-cvs] r463 - trunk/src/base-tools
by Lukas Giessmann 09 May '11

09 May '11

Author: lgiessmann Date: Mon May 9 10:11:39 2011 New Revision: 463 Log: base-tools: fixed a bug in open-tm-store, when a store-controller is set and so a store is opened Modified: trunk/src/base-tools/base-tools.lisp Modified: trunk/src/base-tools/base-tools.lisp ============================================================================== --- trunk/src/base-tools/base-tools.lisp (original) +++ trunk/src/base-tools/base-tools.lisp Mon May 9 10:11:39 2011 @@ -578,8 +578,8 @@ :register, so one store canbe used by several instances of isidorus in parallel." (if elephant:*store-controller* - (elephant:open-store (get-store-spec pathname) :register t) - elephant:*store-controller*)) + elephant:*store-controller* + (elephant:open-store (get-store-spec pathname) :register t))) (defun close-tm-store ()

1 0

[isidorus-cvs] r462 - in trunk/src: base-tools json/JTM rest_interface unit_tests xml/rdf xml/xtm
by Lukas Giessmann 09 May '11

09 May '11

Author: lgiessmann Date: Mon May 9 09:58:45 2011 New Revision: 462 Log: JTM: added the functions: make-prefix-list-from-jtm-list, import-construct-from-jtm-string, import-from-jtm, import-topic-map-from-jtm-list, and import-role-from-jtm-list Modified: trunk/src/base-tools/base-tools.lisp trunk/src/json/JTM/jtm_aliases.lisp trunk/src/json/JTM/jtm_importer.lisp trunk/src/json/JTM/jtm_tools.lisp trunk/src/rest_interface/rest-interface.lisp trunk/src/unit_tests/jtm_test.lisp trunk/src/xml/rdf/importer.lisp trunk/src/xml/xtm/setup.lisp Modified: trunk/src/base-tools/base-tools.lisp ============================================================================== --- trunk/src/base-tools/base-tools.lisp (original) +++ trunk/src/base-tools/base-tools.lisp Mon May 9 09:58:45 2011 @@ -46,7 +46,8 @@ :prefix-of-uri :get-store-spec :open-tm-store - :close-tm-store)) + :close-tm-store + :read-file)) (in-package :base-tools) @@ -576,9 +577,21 @@ "Wraps the function elephant:open-store with the key-parameter :register, so one store canbe used by several instances of isidorus in parallel." - (elephant:open-store (get-store-spec pathname) :register t)) + (if elephant:*store-controller* + (elephant:open-store (get-store-spec pathname) :register t) + elephant:*store-controller*)) (defun close-tm-store () "Wraps the function elephant:close-store." - (elephant:close-store)) \ No newline at end of file + (elephant:close-store)) + + +(defun read-file (file-path) + "A helper function that reads a file and returns the content as a string." + (with-open-file (stream file-path) + (let ((file-string "")) + (do ((l (read-line stream) (read-line stream nil 'eof))) + ((eq l 'eof)) + (base-tools:push-string (base-tools::concat l (string #\newline)) file-string)) + (subseq file-string 0 (max 0 (1- (length file-string))))))) \ No newline at end of file Modified: trunk/src/json/JTM/jtm_aliases.lisp ============================================================================== --- trunk/src/json/JTM/jtm_aliases.lisp (original) +++ trunk/src/json/JTM/jtm_aliases.lisp Mon May 9 09:58:45 2011 @@ -11,6 +11,7 @@ (:use :cl :json :datamodel :base-tools :isidorus-threading :constants :exceptions :jtm) (:export :import-from-jtm + :import-form-jtm-string :export-as-jtm :export-as-jtm-string :export-construct-as-jtm-string Modified: trunk/src/json/JTM/jtm_importer.lisp ============================================================================== --- trunk/src/json/JTM/jtm_importer.lisp (original) +++ trunk/src/json/JTM/jtm_importer.lisp Mon May 9 09:58:45 2011 @@ -10,17 +10,119 @@ (in-package :jtm) -;TODO: write a generic outer method that evaluates the item_type, -; version, parent, and prefixes and finally calls a special -; function that creates a construct - - (defun get-item (item-keyword jtm-list) (declare (Keyword item-keyword) (List jtm-list)) (rest (find item-keyword jtm-list :key #'first))) +(defun make-prefix-list-from-jtm-list (jtm-list) + "Creates a plist of the form ((:pref 'pref_1' :value 'value-1') + (:pref 'pref_2' :value 'value-2')) if the passed jtm-list is + of the form ((:PREF--1 . 'value-1')(:PREF--2 . 'value-2'))." + (declare (List jtm-list)) + (loop for item in jtm-list + collect (list :pref (json:lisp-to-camel-case + (subseq (write-to-string (first item)) 1)) + :value (rest item)))) + + +(defun import-construct-from-jtm-string (jtm-string &key + (revision *TM-REVISION*) + (jtm-format :1.1) tm-id) + "Imports the passed jtm-string. + Note tm-id needs not to be declared, but if the imported construct + is a topicmap and it has no item-identifiers defined, a JTM-error + is thrown." + (declare (String jtm-string) + (type (or Null String) tm-id)) + + (let* ((jtm-list (json:decode-json-from-string jtm-string)) + (version (get-item :VERSION jtm-list)) + (item_type (get-item :ITEM--TYPE jtm-list)) + (prefixes (make-prefix-list-from-jtm-list (get-item :PREFIXES jtm-list))) + (format-1.1-p (eql jtm-format :1.1))) + (cond ((eql jtm-format :1.0) + (unless (string= version "1.0") + (error (make-condition 'exceptions:JTM-error :message (format nil "From import-construct-from-jtm-string(): the member version must be set to \"1.0\" in JTM version 1.0, but is ~a" version)))) + (when prefixes + (error (make-condition 'exceptions:JTM-error :message (format nil "From import-construct-from-jtm-string(): the member prefixes must not be set when using JTM version 1.0, but found: ~a" prefixes))))) + ((eql jtm-format :1.1) + (unless (string= version "1.1") + (error (make-condition 'exceptions:JTM-error :message (format nil "From import-construct-from-jtm-string(): the member version must be set to \"1.1\" in JTM version 1.1, but is ~a" version))))) + (t + (error (make-condition 'exceptions:JTM-error :message (format nil "From import-construct-from-jtm-string(): only JTM format 1.0 and 1.1 is supported, but found: ~a" jtm-format))))) + (cond ((or (not item_type) + (string= item_type item_type-topicmap)) + (import-topic-map-from-jtm-list + jtm-list tm-id :revision revision :prefixes prefixes + :instance-of-p format-1.1-p)) + ((string= item_type item_type-topic) + (import-topic-stub-from-jtm-list jtm-list nil :revision revision + :prefixes prefixes) + (merge-topic-from-jtm-list jtm-list nil :instance-of-p format-1.1-p + :revision revision :prefixes prefixes)) + ((string= item_type item_type-name) + (import-name-from-jtm-list jtm-list nil :revision revision + :prefixes prefixes)) + ((string= item_type item_type-variant) + (import-variant-from-jtm-list jtm-list nil :revision revision + :prefixes prefixes)) + ((string= item_type item_type-occurrence) + (import-occurrence-from-jtm-list jtm-list nil :revision revision + :prefixes prefixes)) + ((string= item_type item_type-role) + (import-role-from-jtm-list jtm-list nil :revision revision + :prefixes prefixes)) + ((string= item_type item_type-association) + (import-association-from-jtm-list jtm-list nil :revision revision + :prefixes prefixes)) + (t + (error (make-condition 'exceptions:JTM-error :message (format nil "From import-construct-from-jtm-string(): the member \"item_type\" must be set to one of ~a or nil, but found \"~a\". If \"item_type\" is not specified or nil the JTM-data is treated as a topicmap." item_type (list item_type-topicmap item_type-topic item_type-name item_type-variant item_type-occurrence item_type-role item_type-association)))))))) + + +(defun import-from-jtm (jtm-path repository-path &key (tm-id (error "you must provide a stable identifier (PSI-style) for this TM")) (revision *TM-REVISION*) (jtm-format :1.1)) + "Imports the given jtm-file by calling import-construct-from-jtm-string." + (declare (type (or Pathname String) jtm-path repository-path) + (String tm-id) + (Keyword jtm-format) + (Integer revision)) + (open-tm-store repository-path) + (import-construct-from-jtm-string (read-file jtm-path) :tm-id tm-id :revision revision + :jtm-format jtm-format) + (close-tm-store)) + + +(defun import-topic-map-from-jtm-list (jtm-list tm-id &key (revision *TM-REVISION*) + prefixes (instance-of-p t)) + "Creates and returns a topic map corresponding to the tm-id or a given + item-identifier in the jtm-list and returns the tm construct after all + topics and associations contained in the jtm-list has been created." + (declare (List jtm-list prefixes) + (Integer revision) + (Boolean instance-of-p)) + (let* ((iis (let ((value (append (import-identifiers-from-jtm-strings + (get-item :ITEM--IDENTIFIERS jtm-list) + :prefixes prefixes) + (when tm-id + (make-construct 'ItemIdentifierC + :uri tm-id))))) + (unless value + (error (make-condition 'JTM-error :message (format nil "From import-topic-map-from-jtm-list(): no topic-map item-identifier is set for ~a" jtm-list)))) + value)) + (j-tops (get-item :TOPICS jtm-list)) + (j-assocs (get-item :ASSOCIATIONS jtm-list)) + (tm (make-construct 'TopicMapC :start-revision revision + :item-identifiers iis))) + (import-topic-stubs-from-jtm-lists j-tops (list tm) :revision revision + :prefixes prefixes) + (merge-topics-from-jtm-lists j-tops (list tm) :instance-of-p instance-of-p + :revision revision :prefixes prefixes) + (import-associations-from-jtm-lists j-assocs (list tm) :revision revision + :prefixes prefixes) + tm)) + + (defun import-associations-from-jtm-lists (jtm-lists parents &key (revision *TM-REVISION*) prefixes) "Create a listof AssociationC objects corresponding to the passed jtm-lists @@ -33,6 +135,40 @@ jtm-lists)) +(defun import-role-from-jtm-list (jtm-list parent &key (revision *TM-REVISION*) + prefixes) + "Creates and returns a role object form the given jtm-list." + (let* ((iis (import-identifiers-from-jtm-strings + (get-item :ITEM--IDENTIFIERS jtm-list) + :prefixes prefixes)) + (type (get-item :TYPE jtm-list)) + (reifier (get-item :REIFIER jtm-list)) + (player (get-item :PLAYER jtm-list)) + (parent-reference (get-item :PARENT jtm-list)) + (local-parent + (if parent + parent + (when parent-reference + (get-item-from-jtm-reference + parent-reference :revision revision :prefixes prefixes))))) + (unless local-parent + (error (make-condition 'JTM-error :message (format nil "From import-role-from-jtm-list(): the JTM role ~a must have exactly one parent set in its members." jtm-list)))) + (unless type + (error (make-condition 'JTM-error :message (format nil "From import-role-from-jtm-list(): the role ~a must have exactly one type set as member." jtm-list)))) + (unless player + (error (make-condition 'JTM-error :message (format nil "From import-role-from-jtm-list(): the role ~a must have exactly one player set as member." jtm-list)))) + (make-construct 'RoleC :start-revision revision + :item-identifiers iis + :reifier (when reifier + (get-item-from-jtm-reference + reifier :revision revision :prefixes prefixes)) + :instance-of (get-item-from-jtm-reference + type :revision revision :prefixes prefixes) + :player (get-item-from-jtm-reference + player :revision revision :prefixes prefixes) + :parent local-parent))) + + (defun make-plist-of-jtm-role(jtm-list &key (revision *TM-REVISION*) prefixes) "Returns a plist of the form (:start-revision <rev> :player <top> :instance-of <top> :reifier <top> :item-identifiers <ii>)." Modified: trunk/src/json/JTM/jtm_tools.lisp ============================================================================== --- trunk/src/json/JTM/jtm_tools.lisp (original) +++ trunk/src/json/JTM/jtm_tools.lisp Mon May 9 09:58:45 2011 @@ -11,10 +11,10 @@ (:use :cl :json :datamodel :base-tools :isidorus-threading :constants :exceptions) (:export :import-from-jtm + :import-construct-from-jtm-string :export-as-jtm :export-as-jtm-string :export-construct-as-jtm-string - :*jtm-xtm* :item_type-topicmap :item_type-topic :item_type-name @@ -25,8 +25,6 @@ (in-package :jtm) -(defvar *jtm-xtm* "jtm-xtm"); Represents the currently active TM of the JTM-Importer - (defvar item_type-topicmap "topicmap") (defvar item_type-topic "topic") Modified: trunk/src/rest_interface/rest-interface.lisp ============================================================================== --- trunk/src/rest_interface/rest-interface.lisp (original) +++ trunk/src/rest_interface/rest-interface.lisp Mon May 9 09:58:45 2011 @@ -82,8 +82,7 @@ (setf hunchentoot:*show-lisp-errors-p* t) ;for now (setf hunchentoot:*hunchentoot-default-external-format* (flex:make-external-format :utf-8 :eol-style :lf)) - (unless elephant:*store-controller* - (open-tm-store repository-path)) + (open-tm-store repository-path) (set-up-json-interface) (setf *json-server-acceptor* (make-instance 'hunchentoot:acceptor :address host-name :port port)) @@ -111,8 +110,7 @@ (setf hunchentoot:*hunchentoot-default-external-format* (flex:make-external-format :utf-8 :eol-style :lf)) (setf atom:*base-url* (format nil "http://~a:~a" host-name port)) - (unless elephant:*store-controller* - (open-tm-store repository-path)) + (open-tm-store repository-path) (load conf-file) (publish-feed atom:*tm-feed*) (setf *atom-server-acceptor* Modified: trunk/src/unit_tests/jtm_test.lisp ============================================================================== --- trunk/src/unit_tests/jtm_test.lisp (original) +++ trunk/src/unit_tests/jtm_test.lisp Mon May 9 09:58:45 2011 @@ -49,16 +49,6 @@ (in-package :jtm-test) -(defun read-file (file-path) - "A helper function that reads a file and returns the content as a string." - (with-open-file (stream file-path) - (let ((file-string "")) - (do ((l (read-line stream) (read-line stream nil 'eof))) - ((eq l 'eof)) - (base-tools:push-string (base-tools::concat l (string #\newline)) file-string)) - (subseq file-string 0 (max 0 (1- (length file-string))))))) - - (def-suite jtm-tests :description "tests various functions of the jtm module") @@ -1639,7 +1629,7 @@ (test test-make-instance-of-association - "Tests the function make-instance-of-association." + "Tests the function make-instance-of-association."1 (with-fixture with-empty-db ("data_base") (let* ((tt (make-construct 'TopicC :start-revision 100 :psis @@ -2211,6 +2201,12 @@ +;TODO: +; *import-role-from-jtm-list +; *import-construct-from-jtm-string +; *import-from-jtm +; *import-topic-map-from-jtm-list + (defun run-jtm-tests() "Runs all tests of this test-suite." (it.bese.fiveam:run! 'jtm-tests)) \ No newline at end of file Modified: trunk/src/xml/rdf/importer.lisp ============================================================================== --- trunk/src/xml/rdf/importer.lisp (original) +++ trunk/src/xml/rdf/importer.lisp Mon May 9 09:58:45 2011 @@ -15,8 +15,7 @@ to the give file path is imported." (declare ((or pathname string) rdf-xml-path)) (declare ((or pathname string) repository-path)) - (unless elephant:*store-controller* - (open-tm-store repository-path)) + (open-tm-store repository-path) (xtm-importer:init-isidorus) (init-rdf-module) (import-from-rdf rdf-xml-path repository-path :tm-id tm-id @@ -34,8 +33,7 @@ (setf *document-id* document-id) (tm-id-p tm-id "rdf-importer") (with-writer-lock - (unless elephant:*store-controller* - (open-tm-store repository-path)) + (open-tm-store repository-path) (let ((rdf-dom (dom:document-element (cxml:parse-file (truename rdf-xml-path) Modified: trunk/src/xml/xtm/setup.lisp ============================================================================== --- trunk/src/xml/xtm/setup.lisp (original) +++ trunk/src/xml/xtm/setup.lisp Mon May 9 09:58:45 2011 @@ -26,8 +26,7 @@ (let ((xtm-dom (dom:document-element (cxml:parse-file (truename xtm-path) (cxml-dom:make-dom-builder))))) - (unless elephant:*store-controller* - (open-tm-store repository-path)) + (open-tm-store repository-path) ;create the topic stubs so that we can refer to them later on (setf d:*current-xtm* xtm-id) (if (eq xtm-format :2.0) @@ -48,8 +47,7 @@ (declare (type (or pathname string) xtm-path repository-path) (String tm-id xtm-id) (Keyword xtm-format)) - (unless elephant:*store-controller* - (open-tm-store repository-path)) + (open-tm-store repository-path) (init-isidorus) (import-from-xtm xtm-path repository-path :tm-id tm-id :xtm-id xtm-id :xtm-format xtm-format)

1 0

[isidorus-cvs] r461 - in trunk/src: json/JTM unit_tests
by Lukas Giessmann 09 May '11

09 May '11

Author: lgiessmann Date: Mon May 9 07:45:02 2011 New Revision: 461 Log: JTM: added the functions import-associaiton-from-jtm-list and import-associations-from-jtm-lists; added unit-tests for imporkting jtm-associations Modified: trunk/src/json/JTM/jtm_importer.lisp trunk/src/unit_tests/jtm_test.lisp Modified: trunk/src/json/JTM/jtm_importer.lisp ============================================================================== --- trunk/src/json/JTM/jtm_importer.lisp (original) +++ trunk/src/json/JTM/jtm_importer.lisp Mon May 9 07:45:02 2011 @@ -21,6 +21,86 @@ (rest (find item-keyword jtm-list :key #'first))) +(defun import-associations-from-jtm-lists (jtm-lists parents &key + (revision *TM-REVISION*) prefixes) + "Create a listof AssociationC objects corresponding to the passed jtm-lists + and returns it." + (declare (List jtm-lists parents prefixes) + (Integer revision)) + (map 'list #'(lambda(jtm-list) + (import-association-from-jtm-list + jtm-list parents :revision revision :prefixes prefixes)) + jtm-lists)) + + +(defun make-plist-of-jtm-role(jtm-list &key (revision *TM-REVISION*) prefixes) + "Returns a plist of the form (:start-revision <rev> :player <top> + :instance-of <top> :reifier <top> :item-identifiers <ii>)." + (unless (and (get-item :PLAYER jtm-list) + (get-item :TYPE jtm-list)) + (error (make-condition 'JTM-error :message (format nil "From make-plist-of-jtm-role(): the role ~a must have a type and player member set." jtm-list)))) + (list :start-revision revision + :player (get-item-from-jtm-reference + (get-item :PLAYER jtm-list) + :revision revision :prefixes prefixes) + :instance-of (get-item-from-jtm-reference + (get-item :TYPE jtm-list) + :revision revision :prefixes prefixes) + :item-identifiers (import-identifiers-from-jtm-strings + (get-item :ITEM--IDENTIFIERS jtm-list) + :prefixes prefixes) + :reifier (when (get-item :REIFIER jtm-list) + (get-item-from-jtm-reference + (get-item :REIFIER jtm-list) + :revision revision :prefixes prefixes)))) + + +(defun import-association-from-jtm-list (jtm-list parents &key + (revision *TM-REVISION*) prefixes) + "Create an AssociationC object corresponding to the passed jtm-list and + returns it." + (declare (List jtm-list parents prefixes) + (Integer revision)) + (let* ((iis (import-identifiers-from-jtm-strings + (get-item :ITEM--IDENTIFIERS jtm-list) + :prefixes prefixes)) + (scope (get-item :SCOPE jtm-list)) + (type (get-item :TYPE jtm-list)) + (reifier (get-item :REIFIER jtm-list)) + (parent-references (get-item :PARENT jtm-list)) + (role-lists + (map 'list #'(lambda(role) + (make-plist-of-jtm-role role :revision revision + :prefixes prefixes)) + (get-item :ROLES jtm-list))) + (local-parent + (if parents + parents + (when parent-references + (get-items-from-jtm-references + parent-references :revision revision :prefixes prefixes))))) + (unless local-parent + (error (make-condition 'JTM-error :message (format nil "From import-association-from-jtm-list(): the JTM association ~a must have at least one parent set in its members." jtm-list)))) + (unless role-lists + (error (make-condition 'JTM-error :message (format nil "From import-association-from-jtm-list(): the JTM association ~a must have at least one role set in its members." jtm-list)))) + (unless type + (error (make-condition 'JTM-error :message (format nil "From import-association-from-jtm-list(): the association ~a must have exactly one type set as member." jtm-list)))) + (let ((assoc + (make-construct 'AssociationC :start-revision revision + :item-identifiers iis + :themes (get-items-from-jtm-references + scope :revision revision :prefixes prefixes) + :reifier (when reifier + (get-item-from-jtm-reference + reifier :revision revision :prefixes prefixes)) + :instance-of (get-item-from-jtm-reference + type :revision revision :prefixes prefixes) + :roles role-lists))) + (dolist (tm local-parent) + (add-to-tm tm assoc)) + assoc))) + + (defun import-topic-stubs-from-jtm-lists (jtm-lists parents &key (revision *TM-REVISION*) prefixes) "Creates and returns a list of topics. @@ -78,7 +158,7 @@ (List parents) (Integer revision)) (unless parents - (error (make-condition 'missing-reference-error :message (format nil "From make-instance-of-association(): parents must contain at least one TopicMapC object, but is nil")))) + (error (make-condition 'JTM-error :message (format nil "From make-instance-of-association(): parents must contain at least one TopicMapC object, but is nil")))) (let ((t-top (get-item-by-psi *type-psi* :revision revision)) (i-top (get-item-by-psi *instance-psi* :revision revision)) (ti-top (get-item-by-psi *type-instance-psi* :revision revision))) @@ -87,14 +167,15 @@ ((not i-top) *instance-psi*) (t *type-instance-psi*)))) (error (make-condition 'missing-reference-error :message (format nil "From make-instance-of-association(): the core topics ~a, ~a, and ~a are necessary, but ~a cannot be found" *type-psi* *instance-psi* *type-instance-psi* missing-topic) :reference missing-topic)))) - (let ((assoc (make-construct 'AssociationC :start-revision revision - :instance-of ti-top - :roles (list (list :start-revision revision - :player instance-top - :instance-of i-top) - (list :start-revision revision - :player type-top - :instance-of t-top))))) + (let ((assoc + (make-construct 'AssociationC :start-revision revision + :instance-of ti-top + :roles (list (list :start-revision revision + :player instance-top + :instance-of i-top) + (list :start-revision revision + :player type-top + :instance-of t-top))))) (dolist (tm parents) (add-to-tm tm i-top) (add-to-tm tm t-top) @@ -183,7 +264,7 @@ (get-items-from-jtm-references parent-references :revision revision :prefixes prefixes))))) (when (/= (length local-parent) 1) - (error (make-condition 'JTM-error :message (format nil "From import-name-from-jtm-string(): the JTM name ~a must have exactly one parent set in its members." jtm-list)))) + (error (make-condition 'JTM-error :message (format nil "From import-name-from-jtm-list(): the JTM name ~a must have exactly one parent set in its members." jtm-list)))) (let ((name (make-construct 'NameC :start-revision revision @@ -227,9 +308,9 @@ (get-items-from-jtm-references parent-references :revision revision :prefixes prefixes))))) (when (/= (length local-parent) 1) - (error (make-condition 'JTM-error :message (format nil "From import-occurrence-from-jtm-string(): the JTM occurrence ~a must have a parent set in its members." jtm-list)))) + (error (make-condition 'JTM-error :message (format nil "From import-occurrence-from-jtm-list(): the JTM occurrence ~a must have a parent set in its members." jtm-list)))) (unless type - (error (make-condition 'JTM-error :message (format nil "From import-occurrence-from-jtm-string(): the JTM occurrence ~a must have a type set in its members." jtm-list)))) + (error (make-condition 'JTM-error :message (format nil "From import-occurrence-from-jtm-list(): the JTM occurrence ~a must have a type set in its members." jtm-list)))) (make-construct 'OccurrenceC :start-revision revision :item-identifiers iis :datatype (if datatype datatype *xml-string*) @@ -279,7 +360,7 @@ (get-items-from-jtm-references parent-references :revision revision :prefixes prefixes))))) (when (/= (length local-parent) 1) - (error (make-condition 'JTM-error :message (format nil "From import-variant-from-jtm-string(): the JTM variant ~a must have exactly one parent set in its members." jtm-list)))) + (error (make-condition 'JTM-error :message (format nil "From import-variant-from-jtm-list(): the JTM variant ~a must have exactly one parent set in its members." jtm-list)))) (make-construct 'VariantC :start-revision revision :item-identifiers iis :datatype (if datatype datatype *xml-string*) Modified: trunk/src/unit_tests/jtm_test.lisp ============================================================================== --- trunk/src/unit_tests/jtm_test.lisp (original) +++ trunk/src/unit_tests/jtm_test.lisp Mon May 9 07:45:02 2011 @@ -42,7 +42,8 @@ :test-import-names :test-make-instance-of-association :test-import-topics - :test-merge-topics)) + :test-merge-topics + :test-import-associations)) (in-package :jtm-test) @@ -1383,7 +1384,7 @@ (test test-import-variants "Tests the functions import-variant-from-jtm-string and - import-constructs-from-jtm-strings." + import-characteristics-from-jtm-strings." (with-fixture with-empty-db ("data_base") (let* ((prefixes (list (list :pref "xsd" :value *xsd-ns*) (list :pref "pref_1" :value "http://some.where/"))) @@ -1416,7 +1417,7 @@ (var-2 (jtm::import-variant-from-jtm-list (json:decode-json-from-string jtm-var-2) name-1 :revision 100 :prefixes prefixes)) - (vars (jtm::import-constructs-from-jtm-lists + (vars (jtm::import-characteristics-from-jtm-lists (list (json:decode-json-from-string jtm-var-1) (json:decode-json-from-string jtm-var-2)) name-1 #'jtm::import-variant-from-jtm-list :revision 100 @@ -1449,23 +1450,23 @@ (jtm::import-variant-from-jtm-list (json:decode-json-from-string jtm-var-2) nil :revision 100)) (signals exceptions:missing-reference-error - (jtm::import-constructs-from-jtm-lists + (jtm::import-characteristics-from-jtm-lists (list (json:decode-json-from-string jtm-var-3)) nil #'jtm::import-variant-from-jtm-list :revision 100 :prefixes prefixes)) (signals exceptions:JTM-error - (jtm::import-constructs-from-jtm-lists + (jtm::import-characteristics-from-jtm-lists (list (json:decode-json-from-string jtm-var-1)) name-1 #'jtm::import-variant-from-jtm-list :revision 100)) (signals exceptions:JTM-error - (jtm::import-constructs-from-jtm-lists + (jtm::import-characteristics-from-jtm-lists (list (json:decode-json-from-string jtm-var-2)) nil #'jtm::import-variant-from-jtm-list :revision 100))))) (test test-import-occurrences "Tests the functions import-occurrence-from-jtm-string and - import-constructs-from-jtm-strings." + import-characteristics-from-jtm-strings." (with-fixture with-empty-db ("data_base") (let* ((prefixes (list (list :pref "xsd" :value *xsd-ns*) (list :pref "pref_1" :value "http://some.where/"))) @@ -1497,7 +1498,7 @@ (occ-2 (jtm::import-occurrence-from-jtm-list (json:decode-json-from-string jtm-occ-2) parent-1 :revision 100 :prefixes prefixes)) - (occs (jtm::import-constructs-from-jtm-lists + (occs (jtm::import-characteristics-from-jtm-lists (list (json:decode-json-from-string jtm-occ-1) (json:decode-json-from-string jtm-occ-2)) parent-1 #'jtm::import-occurrence-from-jtm-list :revision 100 @@ -1540,23 +1541,23 @@ (jtm::import-occurrence-from-jtm-list (json:decode-json-from-string jtm-occ-2) nil :revision 100)) (signals exceptions:missing-reference-error - (jtm::import-constructs-from-jtm-lists + (jtm::import-characteristics-from-jtm-lists (list (json:decode-json-from-string jtm-occ-3)) nil #'jtm::import-occurrence-from-jtm-list :revision 100 :prefixes prefixes)) (signals exceptions:JTM-error - (jtm::import-constructs-from-jtm-lists + (jtm::import-characteristics-from-jtm-lists (list (json:decode-json-from-string jtm-occ-1)) parent-1 #'jtm::import-occurrence-from-jtm-list :revision 100)) (signals exceptions:JTM-error - (jtm::import-constructs-from-jtm-lists + (jtm::import-characteristics-from-jtm-lists (list (json:decode-json-from-string jtm-occ-2)) nil #'jtm::import-occurrence-from-jtm-list :revision 100))))) (test test-import-names "Tests the functions import-name-from-jtm-list and - import-constructs-from-jtm-lists." + import-characteristics-from-jtm-lists." (with-fixture with-empty-db ("data_base") (let* ((prefixes (list (list :pref "xsd" :value *xsd-ns*) (list :pref "pref_1" :value *xsd-ns*) @@ -1586,7 +1587,7 @@ (name-2 (jtm::import-name-from-jtm-list (json:decode-json-from-string jtm-name-2) parent-1 :revision 100 :prefixes prefixes)) - (names (jtm::import-constructs-from-jtm-lists + (names (jtm::import-characteristics-from-jtm-lists (list (json:decode-json-from-string jtm-name-1) (json:decode-json-from-string jtm-name-2)) parent-1 #'jtm::import-name-from-jtm-list :revision 100 @@ -1623,16 +1624,16 @@ (jtm::import-name-from-jtm-list (json:decode-json-from-string jtm-name-2) nil :revision 100)) (signals exceptions:missing-reference-error - (jtm::import-constructs-from-jtm-lists + (jtm::import-characteristics-from-jtm-lists (list (json:decode-json-from-string jtm-name-3)) nil #'jtm::import-name-from-jtm-list :revision 100 :prefixes prefixes)) (signals exceptions:JTM-error - (jtm::import-constructs-from-jtm-lists + (jtm::import-characteristics-from-jtm-lists (list (json:decode-json-from-string jtm-name-1)) parent-1 #'jtm::import-name-from-jtm-list :revision 100)) (signals exceptions:JTM-error - (jtm::import-constructs-from-jtm-lists + (jtm::import-characteristics-from-jtm-lists (list (json:decode-json-from-string jtm-name-2)) nil #'jtm::import-name-from-jtm-list :revision 100))))) @@ -1704,7 +1705,7 @@ (and (eql (instance-of role :revision 0) it) (eql (player role :revision 0) top-2))) (roles assoc :revision 0)))) - (signals exceptions:missing-reference-error + (signals exceptions:JTM-error (jtm::make-instance-of-association top-1 top-3 nil :revision 100)) (delete-psi tt (elephant:get-instance-by-value 'PersistentIdc 'd:uri *type-psi*) @@ -1846,7 +1847,6 @@ nil :revision 200)))))) - (test test-merge-topics "Tests the functions import-topic-stub-from-jtm-list, and import-topic-stubs-from-jtm-lists." @@ -2012,7 +2012,7 @@ (jtm::merge-topic-from-jtm-list (json:decode-json-from-string j-top-1) (list tm-1 tm-2) :revision 200 :prefixes prefixes :instance-of-p nil)) - (signals exceptions:missing-reference-error + (signals exceptions:JTM-error (jtm::merge-topic-from-jtm-list (json:decode-json-from-string j-top-1) nil :revision 200 :prefixes prefixes)) @@ -2024,12 +2024,193 @@ (jtm::merge-topics-from-jtm-lists (list (json:decode-json-from-string j-top-1)) (list tm-1 tm-2) :revision 200 :prefixes prefixes :instance-of-p nil)) - (signals exceptions:missing-reference-error + (signals exceptions:JTM-error (jtm::merge-topics-from-jtm-lists (list (json:decode-json-from-string j-top-1)) nil :revision 200 :prefixes prefixes))))) +(test test-import-associations + "Tests the functions import-association-from-jtm-list." + (with-fixture with-empty-db ("data_base") + (let* ((prefixes + (list (list :pref "pref_3" + :value "http://psi.topicmaps.org/iso13250/model/") + (list :pref "xsd" :value *xsd-ns*) + (list :pref "pref_1" :value *xsd-ns*) + (list :pref "pref_2" :value "http://some.where/"))) + (j-assoc-1 "{\"item_identifiers\":[\"http:\\/\\/some.where\\/ii\\/association\"],\"type\":\"si:http:\\/\\/some.where\\/tmsparql\\/written-by\",\"reifier\":\"ii:http:\\/\\/some.where\\/ii\\/association-reifier\",\"scope\":null,\"roles\":[{\"item_identifiers\":null,\"type\":\"si:http:\\/\\/some.where\\/tmsparql\\/writer\",\"reifier\":\"ii:http:\\/\\/some.where\\/ii\\/role-reifier\",\"player\":\"si:http:\\/\\/some.where\\/tmsparql\\/author\\/goethe\"},{\"item_identifiers\":[\"http:\\/\\/some.where\\/ii\\/role-2\"],\"type\":\"si:http:\\/\\/some.where\\/tmsparql\\/written\",\"reifier\":null,\"player\":\"si:http:\\/\\/some.where\\/psis\\/poem\\/zauberlehrling\"}]}") + (j-assoc-2 "{\"version\":\"1.1\",\"prefixes\":{\"pref_1\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#\",\"xsd\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#\",\"pref_2\":\"http:\\/\\/some.where\\/\"},\"item_identifiers\":null,\"type\":\"si:[pref_3:type-instance]\",\"reifier\":null,\"scope\":[\"si:[pref_2:my-scope]\"],\"roles\":[{\"item_identifiers\":null,\"type\":\"si:[pref_3:type]\",\"reifier\":null,\"player\":\"si:[pref_2:tmsparql\\/author]\"},{\"item_identifiers\":null,\"type\":\"si:[pref_3:instance]\",\"reifier\":null,\"player\":\"si:[pref_2:tmsparql\\/author\\/goethe]\"}]}") + (goethe (make-construct + 'TopicC :start-revision 100 + :psis + (list (make-construct + 'PersistentIdC + :uri "http://some.where/tmsparql/author/goethe")))) + (zauberlehrling (make-construct + 'TopicC :start-revision 100 + :psis + (list (make-construct + 'PersistentIdC + :uri "http://some.where/psis/poem/zauberlehrling")))) + (author (make-construct + 'TopicC :start-revision 100 + :psis + (list (make-construct + 'PersistentIdC + :uri "http://some.where/tmsparql/author")))) + (tt (make-construct + 'TopicC :start-revision 100 + :psis (list (make-construct 'PersistentIdC + :uri *type-psi*)))) + (it (make-construct + 'TopicC :start-revision 100 + :psis (list (make-construct 'PersistentIdC + :uri *instance-psi*)))) + (tit (make-construct + 'TopicC :start-revision 100 + :psis (list (make-construct 'PersistentIdC + :uri *type-instance-psi*)))) + (written-by (make-construct + 'TopicC :start-revision 100 + :psis + (list (make-construct + 'PersistentIdC + :uri "http://some.where/tmsparql/written-by")))) + (writer (make-construct + 'TopicC :start-revision 100 + :psis + (list (make-construct + 'PersistentIdC + :uri "http://some.where/tmsparql/writer")))) + (written (make-construct + 'TopicC :start-revision 100 + :psis + (list (make-construct + 'PersistentIdC + :uri "http://some.where/tmsparql/written")))) + (reifier-assoc-1 (make-construct + 'TopicC :start-revision 100 + :item-identifiers + (list (make-construct + 'ItemIdentifierC + :uri "http://some.where/ii/association-reifier")))) + (reifier-role-1-1 (make-construct + 'TopicC :start-revision 100 + :item-identifiers + (list (make-construct + 'ItemIdentifierC + :uri "http://some.where/ii/role-reifier")))) + (scope-2 (make-construct + 'TopicC :start-revision 100 + :psis + (list (make-construct + 'PersistentIdC + :uri "http://some.where/my-scope")))) + (tm (make-construct 'TopicMapC :start-revision 100 + :item-idenitfiers + (list (make-construct 'ItemIdentifierC + :uri "http://some.where/tm"))))) + (is (= (length (elephant:get-instances-by-class 'AssociationC)) 0)) + (let ((assoc-1 (jtm::import-association-from-jtm-list + (json:decode-json-from-string j-assoc-1) + (list tm) :revision 100))) + (is (= (length (elephant:get-instances-by-class 'AssociationC)) 1)) + (is (= (length (elephant:get-instances-by-class 'RoleC)) 2)) + (is (eql (instance-of assoc-1 :revision 0) written-by)) + (is-false (set-exclusive-or + (list "http://some.where/ii/association") + (map 'list #'d:uri (item-identifiers assoc-1 :revision 0)) + :test #'string=)) + (is (eql (reifier assoc-1 :revision 0) reifier-assoc-1)) + (is-true (find tm (in-topicmaps assoc-1 :revision 0))) + (is-false (themes assoc-1 :revision 0)) + (= (length (roles assoc-1 :revision 0)) 2) + (is-true (find-if #'(lambda(role) + (and (eql (instance-of role :revision 0) writer) + (eql (player role :revision 0) goethe) + (not (item-identifiers role :revision 0)) + (eql (reifier role :revision 0) + reifier-role-1-1))) + (roles assoc-1 :revision 0))) + (is-true + (find-if #'(lambda(role) + (and (eql (instance-of role :revision 0) written) + (eql (player role :revision 0) zauberlehrling) + (= (length (item-identifiers role :revision 0)) 1) + (string= + "http://some.where/ii/role-2" + (uri (first (item-identifiers role :revision 0)))) + (not (reifier role :revision 0)))) + (roles assoc-1 :revision 0))) + (is (= (length (player-in-roles goethe :revision 0)) 1)) + (is (= (length (player-in-roles zauberlehrling :revision 0)) 1)) + (is (= (length (player-in-roles author :revision 0)) 0))) + (let ((assoc-2 (jtm::import-association-from-jtm-list + (json:decode-json-from-string j-assoc-2) + (list tm) :revision 100 :prefixes prefixes))) + (is (= (length (elephant:get-instances-by-class 'AssociationC)) 2)) + (is (= (length (elephant:get-instances-by-class 'RoleC)) 4)) + (is (eql (instance-of assoc-2 :revision 0) tit)) + (is-false (item-identifiers assoc-2 :revision 0)) + (is-false (reifier assoc-2 :revision 0)) + (is-true (find tm (in-topicmaps assoc-2 :revision 0))) + (is (= (length (themes assoc-2 :revision 0)) 1)) + (is (eql (first (themes assoc-2 :revision 0)) scope-2)) + (= (length (roles assoc-2 :revision 0)) 2) + (is-true (find-if #'(lambda(role) + (and (eql (instance-of role :revision 0) tt) + (eql (player role :revision 0) author) + (not (item-identifiers role :revision 0)) + (not (reifier role :revision 0)))) + (roles assoc-2 :revision 0))) + (is-true + (find-if #'(lambda(role) + (and (eql (instance-of role :revision 0) it) + (eql (player role :revision 0) goethe) + (not (item-identifiers role :revision 0)) + (not (reifier role :revision 0)))) + (roles assoc-2 :revision 0))) + (is (= (length (player-in-roles goethe :revision 0)) 2)) + (is (= (length (player-in-roles zauberlehrling :revision 0)) 1)) + (is (= (length (player-in-roles author :revision 0)) 1))) + (let ((assocs (jtm::import-associations-from-jtm-lists + (list (json:decode-json-from-string j-assoc-1) + (json:decode-json-from-string j-assoc-2)) + (list tm) :revision 200 :prefixes prefixes))) + (is (= (length assocs) 2)) + (is (= (length (player-in-roles goethe :revision 0)) 2)) + (is (= (length (player-in-roles zauberlehrling :revision 0)) 1)) + (is (= (length (player-in-roles author :revision 0)) 1))) + (signals exceptions::JTM-error + (jtm::import-association-from-jtm-list + (json:decode-json-from-string j-assoc-1) + nil :revision 100)) + (signals exceptions::JTM-error + (jtm::import-association-from-jtm-list + (json:decode-json-from-string j-assoc-2) + nil :revision 100)) + (signals exceptions::JTM-error + (jtm::import-association-from-jtm-list + (json:decode-json-from-string + "{\"item_identifiers\":null,\"type\":\"si:http:\\/\\/some.where\\/tmsparql\\/written-by\",\"reifier\":null,\"scope\":null,\"roles\":null}") + (list tm) :revision 100)) + (signals exceptions::JTM-error + (jtm::import-association-from-jtm-list + (json:decode-json-from-string + "{\"item_identifiers\":null,\"type\":null,\"reifier\":null,\"scope\":null,\"roles\":[{\"item_identifiers\":null,\"type\":\"si:http:\\/\\/some.where\\/tmsparql\\/writer\",\"reifier\":\"ii:http:\\/\\/some.where\\/ii\\/role-reifier\",\"player\":\"si:http:\\/\\/some.where\\/tmsparql\\/author\\/goethe\"}]}") + (list tm) :revision 100)) + (signals exceptions::JTM-error + (jtm::import-associations-from-jtm-lists + (list (json:decode-json-from-string j-assoc-1)) + nil :revision 100)) + (signals exceptions::JTM-error + (jtm::import-associations-from-jtm-lists + (list (json:decode-json-from-string j-assoc-2)) + nil :revision 100))))) + + + (defun run-jtm-tests() "Runs all tests of this test-suite." (it.bese.fiveam:run! 'jtm-tests)) \ No newline at end of file

1 0

[isidorus-cvs] r460 - trunk/src/model
by Lukas Giessmann 09 May '11

09 May '11

Author: lgiessmann Date: Mon May 9 07:38:55 2011 New Revision: 460 Log: datamodel: fixed a bug when merging two associations, whereas each association owns a role that is equivalent to the other and both roles are reified by the same reifier-topic. Modified: trunk/src/model/datamodel.lisp Modified: trunk/src/model/datamodel.lisp ============================================================================== --- trunk/src/model/datamodel.lisp (original) +++ trunk/src/model/datamodel.lisp Mon May 9 07:38:55 2011 @@ -2782,8 +2782,10 @@ (roles construct-1 :revision revision) (roles construct-2 :revision revision) :test #'(lambda(role-1 role-2) - (strictly-equivalent-constructs role-1 role-2 - :revision revision)))))) + ;(strictly-equivalent-constructs role-1 role-2 + ;:revision revision)))))) + (equivalent-constructs role-1 role-2 + :revision revision)))))) (defgeneric AssociationC-p (class-symbol)

1 0