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

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

10 May '11

Author: lgiessmann Date: Tue May 10 11:54:42 2011 New Revision: 470 Log: fixed ticket #111 and adapted all unit-tests Modified: 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/model/changes.lisp trunk/src/model/datamodel.lisp trunk/src/unit_tests/exporter_xtm1.0_test.lisp trunk/src/unit_tests/exporter_xtm2.0_test.lisp trunk/src/unit_tests/importer_test.lisp trunk/src/unit_tests/json_test.lisp trunk/src/unit_tests/jtm_test.lisp trunk/src/unit_tests/rdf_importer_test.lisp trunk/src/unit_tests/reification_test.lisp trunk/src/unit_tests/sparql_test.lisp trunk/src/xml/rdf/exporter.lisp trunk/src/xml/rdf/map_to_tm.lisp trunk/src/xml/xtm/exporter.lisp trunk/src/xml/xtm/exporter_xtm1.0.lisp trunk/src/xml/xtm/exporter_xtm2.0.lisp 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 11:54:42 2011 @@ -492,7 +492,6 @@ (get-item :ITEM--IDENTIFIERS jtm-list) :prefixes prefixes)) (datatype (get-item :DATATYPE jtm-list)) - (scope (get-item :SCOPE jtm-list)) (value (get-item :VALUE jtm-list)) (reifier (get-item :REIFIER jtm-list)) (parent-references (get-item :PARENT jtm-list)) @@ -501,15 +500,21 @@ (list parent) (when parent-references (get-items-from-jtm-references - parent-references :revision revision :prefixes prefixes))))) + parent-references :revision revision :prefixes prefixes)))) + (scopes (when local-parent + (remove-duplicates + (append + (get-items-from-jtm-references + (get-item :SCOPE jtm-list) + :revision revision :prefixes prefixes) + (themes (first local-parent) :revision revision)))))) (when (/= (length local-parent) 1) (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*) :charvalue value - :themes (get-items-from-jtm-references - scope :revision revision :prefixes prefixes) + :themes scopes :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 11:54:42 2011 @@ -101,9 +101,12 @@ (identifiers-to-json-string instance :what 'item-identifiers :revision revision))) (scope - (concat "\"scopes\":" (ref-topics-to-json-string - (themes instance :revision revision) - :revision revision))) + (concat "\"scopes\":" + (ref-topics-to-json-string + (set-difference (themes instance :revision revision) + (when-do name (parent instance :revision revision) + (themes name :revision revision))) + :revision revision))) (resourceX (let ((value (when (slot-boundp instance 'charvalue) 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 11:54:42 2011 @@ -289,7 +289,7 @@ (getf json-decoded-list :itemIdentities))) (themes (remove-duplicates - (append (d:themes name) + (append (d:themes name :revision start-revision) (json-to-scope (getf json-decoded-list :scopes) start-revision)))) (variant-value Modified: trunk/src/model/changes.lisp ============================================================================== --- trunk/src/model/changes.lisp (original) +++ trunk/src/model/changes.lisp Tue May 10 11:54:42 2011 @@ -66,12 +66,17 @@ (defmethod find-referenced-topics ((characteristic CharacteristicC) &key (revision *TM-REVISION*)) - "characteristics are scopable + typable + reifiable" + "Characteristics are scopable + typable + reifiable. + Note the tmdm:topic-name is ignored if it is only set + as a nametype." (append (when (reifier characteristic :revision revision) (list (reifier characteristic :revision revision))) (themes characteristic :revision revision) - (when (instance-of characteristic :revision revision) + (when (and (not (and (typep characteristic 'NameC) + (eql (instance-of characteristic :revision revision) + (get-item-by-psi *topic-name-psi* :revision revision)))) + (instance-of characteristic :revision revision)) (list (instance-of characteristic :revision revision))) (when (and (typep characteristic 'NameC) (variants characteristic :revision revision)) Modified: trunk/src/model/datamodel.lisp ============================================================================== --- trunk/src/model/datamodel.lisp (original) +++ trunk/src/model/datamodel.lisp Tue May 10 11:54:42 2011 @@ -1575,10 +1575,9 @@ (and sl-provided-p (some (lambda (psi) (string-starts-with (uri psi) source-locator)) (psis top :revision 0)))) - (unless sl-provided-p - (mapc (lambda(psi)(mark-as-deleted psi :revision revision - :source-locator source-locator)) - (psis top :revision 0))) + (mapc (lambda(psi)(mark-as-deleted psi :revision revision + :source-locator source-locator)) + (psis top :revision 0)) (mapc (lambda(sl)(mark-as-deleted sl :revision revision :source-locator source-locator)) (locators top :revision 0)) Modified: trunk/src/unit_tests/exporter_xtm1.0_test.lisp ============================================================================== --- trunk/src/unit_tests/exporter_xtm1.0_test.lisp (original) +++ trunk/src/unit_tests/exporter_xtm1.0_test.lisp Tue May 10 11:54:42 2011 @@ -17,7 +17,7 @@ (let ((document (dom:document-element (cxml:parse-file *out-xtm1.0-file* (cxml-dom:make-dom-builder)))) (topic-counter 0)) - (check-document-structure document 38 2 :ns-uri *xtm1.0-ns*) + (check-document-structure document 39 2 :ns-uri *xtm1.0-ns*) (loop for topic across (xpath-child-elems-by-qname document *xtm1.0-ns* "topic") do (loop for subjectIndicatorRef across (xpath-child-elems-by-qname (xpath-single-child-elem-by-qname @@ -99,7 +99,7 @@ (with-fixture refill-test-db() (export-as-xtm *out-xtm1.0-file* :xtm-format :1.0) (let ((document (dom:document-element (cxml:parse-file *out-xtm1.0-file* (cxml-dom:make-dom-builder))))) - (check-document-structure document 38 2 :ns-uri *xtm1.0-ns*) + (check-document-structure document 39 2 :ns-uri *xtm1.0-ns*) (loop for topic across (xpath-child-elems-by-qname document *xtm1.0-ns* "topic") do (loop for subjectIndicatorRef across (xpath-child-elems-by-qname (xpath-single-child-elem-by-qname @@ -141,7 +141,7 @@ (with-fixture refill-test-db() (export-as-xtm *out-xtm1.0-file* :xtm-format :1.0) (let ((document (dom:document-element (cxml:parse-file *out-xtm1.0-file* (cxml-dom:make-dom-builder))))) - (check-document-structure document 38 2 :ns-uri *xtm1.0-ns*) + (check-document-structure document 39 2 :ns-uri *xtm1.0-ns*) (loop for topic across (xpath-child-elems-by-qname document *xtm1.0-ns* "topic") do (loop for subjectIndicatorRef across (xpath-child-elems-by-qname (xpath-single-child-elem-by-qname @@ -200,7 +200,7 @@ (export-as-xtm *out-xtm1.0-file* :xtm-format :1.0) (let ((document (dom:document-element (cxml:parse-file *out-xtm1.0-file* (cxml-dom:make-dom-builder)))) (t100-occurrences-resourceData (list "The ISO 19115 standard ..." "2003-01-01"))) ;local value->no type - (check-document-structure document 38 2 :ns-uri *xtm1.0-ns*) + (check-document-structure document 39 2 :ns-uri *xtm1.0-ns*) (loop for topic across (xpath-child-elems-by-qname document *xtm1.0-ns* "topic") do (loop for subjectIndicatorRef across (xpath-child-elems-by-qname (xpath-single-child-elem-by-qname @@ -234,7 +234,7 @@ (with-fixture refill-test-db() (export-as-xtm *out-xtm1.0-file* :xtm-format :1.0) (let ((document (dom:document-element (cxml:parse-file *out-xtm1.0-file* (cxml-dom:make-dom-builder))))) - (check-document-structure document 38 2 :ns-uri *xtm1.0-ns*) + (check-document-structure document 39 2 :ns-uri *xtm1.0-ns*) (loop for topic across (xpath-child-elems-by-qname document *xtm1.0-ns* "topic") do (loop for subjectIndicatorRef across (xpath-child-elems-by-qname (xpath-single-child-elem-by-qname @@ -294,7 +294,7 @@ (with-fixture refill-test-db() (export-as-xtm *out-xtm1.0-file* :xtm-format :1.0) (let ((document (dom:document-element (cxml:parse-file *out-xtm1.0-file* (cxml-dom:make-dom-builder))))) - (check-document-structure document 38 2 :ns-uri *xtm1.0-ns*) + (check-document-structure document 39 2 :ns-uri *xtm1.0-ns*) (loop for association across (xpath-child-elems-by-qname document *xtm1.0-ns* "association") do (let ((instanceOfs (xpath-child-elems-by-qname association *xtm1.0-ns* "instanceOf"))) (is (= (length instanceOfs) 1)) @@ -445,7 +445,7 @@ (dom:document-element (cxml:parse-file *out-xtm1.0-file* (cxml-dom:make-dom-builder)))) (t100-occurrences-resourceData (list "The ISO 19115 standard ..." "2003-01-01"))) ;local value->no type - (check-document-structure document 47 7 :ns-uri *xtm1.0-ns*) + (check-document-structure document 48 7 :ns-uri *xtm1.0-ns*) (loop for topic across (xpath-child-elems-by-qname document *xtm1.0-ns* "topic") do (loop for subjectIndicatorRef across (xpath-child-elems-by-qname (xpath-single-child-elem-by-qname @@ -632,7 +632,7 @@ (export-as-xtm *out-xtm1.0-file* :revision fixtures::revision2 :xtm-format :1.0) (let ((document (dom:document-element (cxml:parse-file *out-xtm1.0-file* (cxml-dom:make-dom-builder)))) (t100-occurrences-resourceData (list "The ISO 19115 standard ..." "2003-01-01"))) ;local value->no type - (check-document-structure document 48 7 :ns-uri *xtm1.0-ns*) + (check-document-structure document 49 7 :ns-uri *xtm1.0-ns*) (loop for topic across (xpath-child-elems-by-qname document *xtm1.0-ns* "topic") do (loop for subjectIndicatorRef across (xpath-child-elems-by-qname (xpath-single-child-elem-by-qname @@ -846,7 +846,7 @@ (export-as-xtm *out-xtm1.0-file* :revision fixtures::revision3 :xtm-format :1.0) (let ((document (dom:document-element (cxml:parse-file *out-xtm1.0-file* (cxml-dom:make-dom-builder)))) (t100-occurrences-resourceData (list "The ISO 19115 standard ..." "2003-01-01"))) ;local value->no type - (check-document-structure document 48 8 :ns-uri *xtm1.0-ns*) + (check-document-structure document 49 8 :ns-uri *xtm1.0-ns*) (loop for topic across (xpath-child-elems-by-qname document *xtm1.0-ns* "topic") do (loop for subjectIndicatorRef across (xpath-child-elems-by-qname (xpath-single-child-elem-by-qname Modified: trunk/src/unit_tests/exporter_xtm2.0_test.lisp ============================================================================== --- trunk/src/unit_tests/exporter_xtm2.0_test.lisp (original) +++ trunk/src/unit_tests/exporter_xtm2.0_test.lisp Tue May 10 11:54:42 2011 @@ -558,7 +558,7 @@ (cxml:parse-file *out-xtm2.0-file* (cxml-dom:make-dom-builder)))) (topic-counter 0)) - (check-document-structure document 38 2) + (check-document-structure document 39 2) (loop for topic across (xpath-child-elems-by-qname document *xtm2.0-ns* "topic") do (loop for subjectIdentifier across (xpath-child-elems-by-qname topic *xtm2.0-ns* "subjectIdentifier") @@ -638,7 +638,7 @@ (with-fixture refill-test-db() (export-as-xtm *out-xtm2.0-file*) (let ((document (dom:document-element (cxml:parse-file *out-xtm2.0-file* (cxml-dom:make-dom-builder))))) - (check-document-structure document 38 2) + (check-document-structure document 39 2) (loop for topic across (xpath-child-elems-by-qname document *xtm2.0-ns* "topic") do (loop for subjectIdentifier across (xpath-child-elems-by-qname topic *xtm2.0-ns* "subjectIdentifier") do (let ((href (dom:node-value (dom:get-attribute-node subjectIdentifier "href")))) @@ -684,7 +684,7 @@ (with-fixture refill-test-db() (export-as-xtm *out-xtm2.0-file*) (let ((document (dom:document-element (cxml:parse-file *out-xtm2.0-file* (cxml-dom:make-dom-builder))))) - (check-document-structure document 38 2) + (check-document-structure document 39 2) (loop for topic across (xpath-child-elems-by-qname document *xtm2.0-ns* "topic") do (loop for subjectIdentifier across (xpath-child-elems-by-qname topic *xtm2.0-ns* "subjectIdentifier") do (let ((href (dom:node-value (dom:get-attribute-node subjectIdentifier "href")))) @@ -751,7 +751,7 @@ (with-fixture refill-test-db() (export-as-xtm *out-xtm2.0-file*) (let ((document (dom:document-element (cxml:parse-file *out-xtm2.0-file* (cxml-dom:make-dom-builder))))) - (check-document-structure document 38 2) + (check-document-structure document 39 2) (loop for topic across (xpath-child-elems-by-qname document *xtm2.0-ns* "topic") do (loop for subjectIdentifier across (xpath-child-elems-by-qname topic *xtm2.0-ns* "subjectIdentifier") do (let ((href (dom:node-value (dom:get-attribute-node subjectIdentifier "href")))) @@ -788,7 +788,7 @@ (with-fixture refill-test-db () (export-as-xtm *out-xtm2.0-file*) (let ((document (dom:document-element (cxml:parse-file *out-xtm2.0-file* (cxml-dom:make-dom-builder))))) - (check-document-structure document 38 2) + (check-document-structure document 39 2) (loop for topic across (xpath-child-elems-by-qname document *xtm2.0-ns* "topic") do (loop for subjectIdentifier across (xpath-child-elems-by-qname topic *xtm2.0-ns* "subjectIdentifier") do (let ((href (dom:node-value (dom:get-attribute-node subjectIdentifier "href")))) @@ -857,7 +857,7 @@ (with-fixture refill-test-db() (export-as-xtm *out-xtm2.0-file*) (let ((document (dom:document-element (cxml:parse-file *out-xtm2.0-file* (cxml-dom:make-dom-builder))))) - (check-document-structure document 38 2) + (check-document-structure document 39 2) (let ((assoc-1 (elt (xpath-child-elems-by-qname document *xtm2.0-ns* "association") 0)) (assoc-2 (elt (xpath-child-elems-by-qname document *xtm2.0-ns* "association") 1))) (let ((assoc-1-type (get-subjectIdentifier-by-ref @@ -1093,7 +1093,7 @@ (handler-case (delete-file *out-xtm2.0-file*)(error () )) ;deletes file - if exist (export-as-xtm *out-xtm2.0-file* :revision fixtures::revision1) (let ((document (dom:document-element (cxml:parse-file *out-xtm2.0-file* (cxml-dom:make-dom-builder))))) - (check-document-structure document 47 7) + (check-document-structure document 48 7) (loop for topic across (xpath-child-elems-by-qname document *xtm2.0-ns* "topic") do (loop for subjectIdentifier across (xpath-child-elems-by-qname topic *xtm2.0-ns* "subjectIdentifier") do (let ((href (dom:get-attribute subjectIdentifier "href"))) @@ -1328,7 +1328,7 @@ (handler-case (delete-file *out-xtm2.0-file*)(error () )) ;deletes file - if exist (export-as-xtm *out-xtm2.0-file* :revision fixtures::revision2) (let ((document (dom:document-element (cxml:parse-file *out-xtm2.0-file* (cxml-dom:make-dom-builder))))) - (check-document-structure document 48 7) + (check-document-structure document 49 7) (loop for topic across (xpath-child-elems-by-qname document *xtm2.0-ns* "topic") do (loop for subjectIdentifier across (xpath-child-elems-by-qname topic *xtm2.0-ns* "subjectIdentifier") do (let ((href (dom:get-attribute subjectIdentifier "href"))) @@ -1611,7 +1611,7 @@ (handler-case (delete-file *out-xtm2.0-file*)(error () )) ;deletes file - if exist (export-as-xtm *out-xtm2.0-file* :revision fixtures::revision3) (let ((document (dom:document-element (cxml:parse-file *out-xtm2.0-file* (cxml-dom:make-dom-builder))))) - (check-document-structure document 48 8) + (check-document-structure document 49 8) (loop for topic across (xpath-child-elems-by-qname document *xtm2.0-ns* "topic") do (loop for subjectIdentifier across (xpath-child-elems-by-qname topic *xtm2.0-ns* "subjectIdentifier") do (let ((href (dom:get-attribute subjectIdentifier "href"))) Modified: trunk/src/unit_tests/importer_test.lisp ============================================================================== --- trunk/src/unit_tests/importer_test.lisp (original) +++ trunk/src/unit_tests/importer_test.lisp Tue May 10 11:54:42 2011 @@ -213,9 +213,9 @@ (is (= 3 (length (occurrences top-t301 :revision rev-1)))) ;after merge (is (string= "http://www.topicmaps.org/xtm/1.0/core.xtm#supertype-subtype" (uri (first (psis top-sup-sub :revision rev-1))))))) - ;34 topics in 35 topic elements in notificationbase.xtm and 13 + ;34 topics in 35 topic elements in notificationbase.xtm and 14 ;core topics - (is (= (+ 34 13) (length (elephant:get-instances-by-class 'TopicC)))))) + (is (= (+ 34 14) (length (elephant:get-instances-by-class 'TopicC)))))) (test test-from-role-elem "Test the form-role-elem function of the importer" @@ -367,7 +367,7 @@ (xtm-importer:setup-repository *t100.xtm* dir :xtm-id *TEST-TM* :tm-id "http://www.isidor.us/unittests/topic-t100") (open-tm-store dir) - (is (= 25 (length (elephant:get-instances-by-class 'TopicC)))) ;; are all topics in the db +std topics + (is (= 26 (length (elephant:get-instances-by-class 'TopicC)))) ;; are all topics in the db + std topics (is-true (get-item-by-id "t100" :revision 0)) ;; main topic (is-true (get-item-by-id "t3a" :revision 0)) ;; instanceOf (is-true (get-item-by-id "t50a" :revision 0)) ;; scope @@ -444,14 +444,14 @@ :xtm-id *TEST-TM* :xtm-format :1.0) (setf *TM-REVISION* 0) (open-tm-store dir) - ;13 + (23 core topics) - (is (= 36 (length (elephant:get-instances-by-class 'TopicC)))) + ;14 + (23 core topics) + (is (= 37 (length (elephant:get-instances-by-class 'TopicC)))) ;2 + (11 instanceOf) (is (= 13 (length (elephant:get-instances-by-class 'AssociationC)))) ;4 + (22 instanceOf-associations) (is (= 26 (length (elephant:get-instances-by-class 'RoleC)))) - ;23 + (13 core topics) - (is (= 36 (length (elephant:get-instances-by-class 'PersistentIdC)))) + ;23 + (14 core topics) + (is (= 37 (length (elephant:get-instances-by-class 'PersistentIdC)))) (is (= 0 (length (elephant:get-instances-by-class 'SubjectLocatorC)))) ;2 + (0 core topics) (is (= 2 (length (elephant:get-instances-by-class 'OccurrenceC)))) Modified: trunk/src/unit_tests/json_test.lisp ============================================================================== --- trunk/src/unit_tests/json_test.lisp (original) +++ trunk/src/unit_tests/json_test.lisp Tue May 10 11:54:42 2011 @@ -294,17 +294,10 @@ "http://psi.egovpt.org/itemIdentifiers#t101_n2_v1") (string= (second (getf variant :itemIdentities)) "http://psi.egovpt.org/itemIdentifiers#t101_n2_v2"))) - (is (= (length (getf variant :scopes)) 2)) + (is (= (length (getf variant :scopes)) 1)) (is (= (length (first (getf variant :scopes))) 1)) - (is (= (length (second (getf variant :scopes))) 1)) - (is (or (string= (first (first (getf variant :scopes))) - "http://www.topicmaps.org/xtm/1.0/core.xtm#sort") - (string= (first (first (getf variant :scopes))) - "http://psi.egovpt.org/types/long-name"))) - (is (or (string= (first (second (getf variant :scopes))) - "http://www.topicmaps.org/xtm/1.0/core.xtm#sort") - (string= (first (second (getf variant :scopes))) - "http://psi.egovpt.org/types/long-name"))) + (is (string= (first (first (getf variant :scopes))) + "http://www.topicmaps.org/xtm/1.0/core.xtm#sort")) (is-false (getf variant :resourceRef)) (is (string= (getf (getf variant :resourceData) :datatype) "http://www.w3.org/2001/XMLSchema#string")) @@ -559,11 +552,11 @@ (with-fixture initialize-destination-db (dir) (open-tm-store dir) (xtm-importer:init-isidorus) - (is (= (length (elephant:get-instances-by-class 'TopicC)) 13)) + (is (= (length (elephant:get-instances-by-class 'TopicC)) 14)) (is (= (length (elephant:get-instances-by-class 'AssociationC)) 0)) (is (= (length (elephant:get-instances-by-class 'TopicMapC)) 1)) (json-importer:import-from-isidorus-json *t64*) - (is (= (length (elephant:get-instances-by-class 'TopicC)) 15)) + (is (= (length (elephant:get-instances-by-class 'TopicC)) 16)) (is (= (length (elephant:get-instances-by-class 'AssociationC)) 1)) (is (= (length (elephant:get-instances-by-class 'TopicMapC)) 2)) (let ((core-tm @@ -577,7 +570,7 @@ "http://www.isidor.us/unittests/testtm") return tm))) (is-true (and core-tm test-tm)) - (is (= (length (topics core-tm)) 13)) + (is (= (length (topics core-tm)) 14)) (is (= (length (associations core-tm)) 0)) (is (= (length (topics test-tm)) (+ 2 3))) (is (= (length (associations test-tm)) 1)))))) @@ -646,7 +639,7 @@ (xtm-importer:init-isidorus) (json-importer:import-from-isidorus-json *t64*) (json-importer:import-from-isidorus-json *t100-3*) - (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 28)) ;13 new topics + (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 29)) ;14 new topics (is (= (length (elephant:get-instances-by-class 'd:AssociationC)) 5)) ;4 new associations (is (= (length (elephant:get-instances-by-class 'TopicMapC)) 2)) (let ((core-tm @@ -660,7 +653,7 @@ "http://www.isidor.us/unittests/testtm") return tm))) (is-true (and core-tm test-tm)) - (is (= (length (topics core-tm)) 13)) + (is (= (length (topics core-tm)) 14)) (is (= (length (associations core-tm)) 0)) (is (= (length (topics test-tm)) (+ 17 3))) (is (= (length (associations test-tm)) 5)))))) @@ -1004,11 +997,11 @@ (with-fixture initialize-destination-db (dir) (open-tm-store dir) (xtm-importer:init-isidorus) - (is (= (length (elephant:get-instances-by-class 'TopicC)) 13)) + (is (= (length (elephant:get-instances-by-class 'TopicC)) 14)) (is (= (length (elephant:get-instances-by-class 'AssociationC)) 0)) (is (= (length (elephant:get-instances-by-class 'TopicMapC)) 1)) (json-importer:import-from-isidorus-json *t100-1*) - (is (= (length (elephant:get-instances-by-class 'TopicC)) 17)) + (is (= (length (elephant:get-instances-by-class 'TopicC)) 18)) (is (= (length (elephant:get-instances-by-class 'AssociationC)) 1)) (is (= (length (elephant:get-instances-by-class 'TopicMapC)) 2)) (let ((core-tm @@ -1023,7 +1016,7 @@ return tm))) (is-true (and core-tm test-tm))) (json-importer:import-from-isidorus-json *t100-2*) - (is (= (length (elephant:get-instances-by-class 'TopicC)) 17)) + (is (= (length (elephant:get-instances-by-class 'TopicC)) 18)) (is (= (length (elephant:get-instances-by-class 'AssociationC)) 1)) (is (= (length (elephant:get-instances-by-class 'TopicMapC)) 2)) (let ((core-tm @@ -1376,6 +1369,9 @@ "http://www.topicmaps.org/xtm/1.0/core.xtm#topic") (is (= (length topic-psis) 1))) ((string= (first topic-psis) + "http://psi.topicmaps.org/iso13250/model/topic-name") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://www.topicmaps.org/xtm/1.0/core.xtm#association") (is (= (length topic-psis) 1))) ((string= (first topic-psis) 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 11:54:42 2011 @@ -1570,6 +1570,11 @@ :locators (list (make-construct 'SubjectLocatorC :uri "http://some.where/sl-1")))) + (type-2 (make-construct + 'TopicC :start-revision 100 + :psis + (list (make-construct 'PersistentIdC + :uri *topic-name-psi*)))) (parent-1 (make-construct 'TopicC :start-revision 100 :psis @@ -1607,7 +1612,7 @@ (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 (eql (instance-of name-2 :revision 0) type-2)) (is-false (set-exclusive-or (map 'list #'d:charvalue (variants name-1 :revision 0)) (list "var-1" "var-2") :test #'string=)) @@ -1864,6 +1869,11 @@ :item-identifiers (list (make-construct 'ItemIdentifierC :uri "http://some.where/tm-1")))) + (topic-name (make-construct + 'TopicC :start-revision 100 + :psis + (list (make-construct 'PersistentIdC + :uri *topic-name-psi*)))) (tm-2 (make-construct 'TopicMapC :start-revision 100 :item-identifiers @@ -1878,8 +1888,8 @@ (list tm-1 tm-2) :revision 100 :prefixes prefixes))) (is (= (length tops) 5)) (is (= (length (remove-duplicates tops)) 4)) - (is (= (length (elephant:get-instances-by-class 'TopicC)) 4)) - (is (= (length (elephant:get-instances-by-class 'PersistentIdC)) 3)) + (is (= (length (elephant:get-instances-by-class 'TopicC)) 5)) + (is (= (length (elephant:get-instances-by-class 'PersistentIdC)) 4)) (is (= (length (elephant:get-instances-by-class 'ItemIdentifierC)) 4)) (is (= (length (elephant:get-instances-by-class 'SubjectLocatorC)) 2)) (is-false (elephant:get-instances-by-class 'NameC)) @@ -1909,8 +1919,8 @@ (top-2 (jtm::merge-topic-from-jtm-list (json:decode-json-from-string j-top-2) (list tm-1 tm-2) :revision 100 :prefixes prefixes))) - (is (= (length (elephant:get-instances-by-class 'TopicC)) 7)) - (is (= (length (elephant:get-instances-by-class 'PersistentIdC)) 6)) + (is (= (length (elephant:get-instances-by-class 'TopicC)) 8)) + (is (= (length (elephant:get-instances-by-class 'PersistentIdC)) 7)) (is (= (length (elephant:get-instances-by-class 'ItemIdentifierC)) 5)) (is (= (length (elephant:get-instances-by-class 'SubjectLocatorC)) 2)) (is (= (length (elephant:get-instances-by-class 'NameC)) 2)) @@ -1922,7 +1932,8 @@ (is (= (length (names top-1 :revision 0)) 2)) (is-true (find-if #'(lambda(name) (and (string= (charvalue name) "name-1") - (not (instance-of name :revision 0)) + (eql (instance-of name :revision 0) + topic-name) (not (themes name :revision 0)) (not (variants name :revision 0)) (not (reifier name :revision 0)) @@ -1931,7 +1942,8 @@ (is-true (find-if #'(lambda(name) (and (string= (charvalue name) "name-2") - (not (instance-of name :revision 0)) + (eql (instance-of name :revision 0) + topic-name) (= (length (themes name :revision 0)) 1) (= (length (locators (first (themes name :revision 0)) :revision 0)) 1) @@ -1995,8 +2007,8 @@ (json:decode-json-from-string j-top-5)) (list tm-1 tm-2) :revision 200 :prefixes prefixes))) (is (= (length (remove-duplicates tops)) 4)) - (is (= (length (elephant:get-instances-by-class 'TopicC)) 7)) - (is (= (length (elephant:get-instances-by-class 'PersistentIdC)) 6)) + (is (= (length (elephant:get-instances-by-class 'TopicC)) 8)) + (is (= (length (elephant:get-instances-by-class 'PersistentIdC)) 7)) (is (= (length (elephant:get-instances-by-class 'ItemIdentifierC)) 5)) (is (= (length (elephant:get-instances-by-class 'SubjectLocatorC)) 2)) (is (= (length (elephant:get-instances-by-class 'NameC)) 2)) @@ -2310,10 +2322,14 @@ (asdf:component-pathname (asdf:find-component constants:*isidorus-system* "unit_tests")) "jtm_1.1_test.jtm")))) + (make-construct 'TopicC :start-revision 100 + :psis + (list (make-construct 'PersistentIdC + :uri *topic-name-psi*))) (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)) + (is (= (length (elephant:get-instances-by-class 'TopicC)) 43)) (loop for top in (elephant:get-instances-by-class 'TopicC) do (cond ((and (= (length (psis top :revision 0)) 1) @@ -2343,6 +2359,19 @@ (is (eql tm (first (in-topicmaps top :revision 0))))) ((and (= (length (psis top :revision 0)) 1) + (string= (uri (first (psis top :revision 0))) + "http://psi.topicmaps.org/iso13250/model/topic-name")) + (is-false (used-as-theme top :revision 0)) + (is-true (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-false (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" @@ -2412,7 +2441,7 @@ (= (length (psis top :revision 0)) 1) (find (uri (first (psis top :revision 0))) - (list + (list "http://some.where/tmsparql/author/goethe" "http://some.where/tmsparql/author" "http://some.where/psis/poem/zauberlehrling" @@ -2447,16 +2476,21 @@ (asdf:component-pathname (asdf:find-component constants:*isidorus-system* "unit_tests")) "jtm_1.1_test.jtm")))) + (make-construct 'TopicC :start-revision 100 + :psis + (list (make-construct 'PersistentIdC + :uri *topic-name-psi*))) (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)) + (is (= (length (elephant:get-instances-by-class 'TopicC)) 43)) (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/topic-name" "http://psi.topicmaps.org/iso13250/model/type-instance" "http://psi.topicmaps.org/iso13250/model/type" "http://psi.topicmaps.org/iso13250/model/instance" @@ -2585,131 +2619,150 @@ (asdf:component-pathname (asdf:find-component constants:*isidorus-system* "unit_tests")) "jtm_1.0_test.jtm"))) + (topic-name + (make-construct 'TopicC :start-revision 100 + :psis + (list (make-construct 'PersistentIdC + :uri *topic-name-psi*)))) (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))))))) + (is-true topic-name) + (is (= (length (elephant:get-instances-by-class 'TopicC)) 43)) + (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) + (string= (uri (first (psis top :revision 0))) + "http://psi.topicmaps.org/iso13250/model/topic-name")) + (is-false (used-as-theme top :revision 0)) + (is-true (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-false (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 @@ -2721,17 +2774,24 @@ (asdf:component-pathname (asdf:find-component constants:*isidorus-system* "unit_tests")) "jtm_1.0_test.jtm"))) + (topic-name + (make-construct 'TopicC :start-revision 100 + :psis + (list (make-construct 'PersistentIdC + :uri *topic-name-psi*)))) (tm (import-construct-from-jtm-string jtm-str :revision 100 :jtm-format :1.0 :tm-id "http://some.where/jtm-tm"))) + (is-true topic-name) (is-true tm) - (is (= (length (elephant:get-instances-by-class 'TopicC)) 42)) + (is (= (length (elephant:get-instances-by-class 'TopicC)) 43)) (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/topic-name" "http://psi.topicmaps.org/iso13250/model/type-instance" "http://psi.topicmaps.org/iso13250/model/type" "http://psi.topicmaps.org/iso13250/model/instance" @@ -2866,6 +2926,10 @@ (asdf:component-pathname (asdf:find-component constants:*isidorus-system* "unit_tests")) "jtm_1.1_test.jtm")))) + (make-construct 'TopicC :start-revision 100 + :psis + (list (make-construct 'PersistentIdC + :uri *topic-name-psi*))) (signals exceptions::JTM-error (import-construct-from-jtm-string jtm-str-1 :revision 100 :jtm-format :1.1)) @@ -2891,6 +2955,11 @@ :locators (list (make-construct 'SubjectLocatorC :uri "http://some.where/sl-1")))) + (type-2 (make-construct + 'TopicC :start-revision 100 + :psis + (list (make-construct 'PersistentIdC + :uri *topic-name-psi*)))) (parent-1 (make-construct 'TopicC :start-revision 100 :psis @@ -2921,7 +2990,7 @@ (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 (eql (instance-of name-2 :revision 0) type-2)) (is-false (set-exclusive-or (map 'list #'d:charvalue (variants name-1 :revision 0)) (list "var-1" "var-2") :test #'string=)) @@ -2940,6 +3009,10 @@ (test test-import-from-jtm-1 "Tests the functionimport-from-jtm." (with-fixture with-empty-db ("data_base") + (make-construct 'TopicC :start-revision 100 + :psis + (list (make-construct 'PersistentIdC + :uri *topic-name-psi*))) (jtm:import-from-jtm (merge-pathnames (asdf:component-pathname @@ -2953,13 +3026,17 @@ (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 'TopicC)) 43)) (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") + (make-construct 'TopicC :start-revision 100 + :psis + (list (make-construct 'PersistentIdC + :uri *topic-name-psi*))) (jtm:import-from-jtm (merge-pathnames (asdf:component-pathname @@ -2974,7 +3051,7 @@ (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 'TopicC)) 43)) (is (= (length (elephant:get-instances-by-class 'AssociationC)) 30)))) Modified: trunk/src/unit_tests/rdf_importer_test.lisp ============================================================================== --- trunk/src/unit_tests/rdf_importer_test.lisp (original) +++ trunk/src/unit_tests/rdf_importer_test.lisp Tue May 10 11:54:42 2011 @@ -1043,7 +1043,7 @@ (rdf-init-db :db-dir db-dir :start-revision revision-1) (rdf-importer::import-node node tm-id revision-2 :document-id document-id) - (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 20)) + (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 21)) (let ((first-node (get-item-by-id "http://test-tm/first-node" :xtm-id document-id :revision 0)) @@ -1264,7 +1264,7 @@ 2)) (rdf-importer::import-dom rdf-node revision-1 :tm-id tm-id :document-id document-id) - (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 40)) + (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 41)) (is (= (length (elephant:get-instances-by-class 'd:AssociationC)) 12)) (setf rdf-importer::*current-xtm* document-id) (is (= (length @@ -1582,7 +1582,7 @@ (date "http://www.w3.org/2001/XMLSchema#date") (de (d:get-item-by-id "http://isidorus/rdf2tm_mapping/scope/de")) (long "http://www.w3.org/2001/XMLSchema#unsignedLong")) - (is (= (length topics) 65)) + (is (= (length topics) 66)) (is (= (length occs) 23)) (is (= (length assocs) 30)) (is-true de) @@ -2574,7 +2574,7 @@ (rdf-init-db :db-dir db-dir :start-revision revision-1) (rdf-importer::import-dom rdf-node revision-1 :tm-id tm-id :document-id document-id) - (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 21)) + (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 22)) (is (= (length (elephant:get-instances-by-class 'd:AssociationC)) 1)) (is (= (length (elephant:get-instances-by-class 'd:OccurrenceC)) 0)) (is (= (length (elephant:get-instances-by-class 'd:NameC)) 0)) @@ -2637,7 +2637,7 @@ (rdf-init-db :db-dir db-dir :start-revision revision-1) (rdf-importer::import-dom rdf-node revision-1 :tm-id tm-id :document-id document-id) - (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 28)) + (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 29)) (is (= (length (elephant:get-instances-by-class 'd:AssociationC)) 6)) (is (= (length (elephant:get-instances-by-class 'd:OccurrenceC)) 0)) (is (= (length (elephant:get-instances-by-class 'd:NameC)) 0)) Modified: trunk/src/unit_tests/reification_test.lisp ============================================================================== --- trunk/src/unit_tests/reification_test.lisp (original) +++ trunk/src/unit_tests/reification_test.lisp Tue May 10 11:54:42 2011 @@ -240,16 +240,20 @@ (test test-xtm1.0-reification "Tests the reification in the xtm1.0-importer." - (let - ((dir "data_base")) + (let ((dir "data_base")) (with-fixture initialize-destination-db (dir) + (base-tools:open-tm-store "data_base") + (make-construct 'TopicC :start-revision 100 + :psis + (list (make-construct 'PersistentIdC + :uri constants:*topic-name-psi*))) (xtm-importer:import-from-xtm *reification_xtm1.0.xtm* dir :tm-id "http://www.isidor.us/unittests/reification-xtm1.0-tests" :xtm-id "reification-xtm" :xtm-format :1.0) (setf *TM-REVISION* 0) - (is (= (length (elephant:get-instances-by-class 'TopicC)) 12)) + (is (= (length (elephant:get-instances-by-class 'TopicC)) 13)) (is (= (length (elephant:get-instances-by-class 'AssociationC)) 1)) (let ((homer (identified-construct @@ -301,20 +305,24 @@ t) (condition () nil))) (is-false (occurrences homer)) - (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 12)) + (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 13)) (close-tm-store)))))) (test test-xtm2.0-reification "Tests the reification in the xtm2.0-importer." - (let - ((dir "data_base")) + (let ((dir "data_base")) (with-fixture initialize-destination-db (dir) + (base-tools:open-tm-store "data_base") + (make-construct 'TopicC :start-revision 100 + :psis + (list (make-construct 'PersistentIdC + :uri constants:*topic-name-psi*))) (xtm-importer:import-from-xtm *reification_xtm2.0.xtm* dir :tm-id "http://www.isidor.us/unittests/reification-xtm2.0-tests" :xtm-id "reification-xtm") - (is (= (length (elephant:get-instances-by-class 'TopicC)) 12)) + (is (= (length (elephant:get-instances-by-class 'TopicC)) 13)) (is (= (length (elephant:get-instances-by-class 'AssociationC)) 1)) (setf *TM-REVISION* 0) (let ((homer @@ -367,17 +375,21 @@ t) (condition () nil))) (is-false (occurrences homer)) - (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 12)) + (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 13)) (close-tm-store)))))) (test test-xtm1.0-reification-exporter "Tests the reification in the xtm1.0-exporter." - (let - ((dir "data_base") - (output-file "__out__.xtm") - (tm-id "http://www.isidor.us/unittests/reification-xtm1.0-tests")) + (let ((dir "data_base") + (output-file "__out__.xtm") + (tm-id "http://www.isidor.us/unittests/reification-xtm1.0-tests")) (with-fixture initialize-destination-db (dir) + (base-tools:open-tm-store "data_base") + (make-construct 'TopicC :start-revision 100 + :psis + (list (make-construct 'PersistentIdC + :uri constants:*topic-name-psi*))) (handler-case (delete-file output-file) (error () )) ;do nothing (setf *TM-REVISION* 0) @@ -466,11 +478,15 @@ (test test-xtm2.0-reification-exporter "Tests the reification in the xtm2.0-exporter." - (let - ((dir "data_base") - (output-file "__out__.xtm") - (tm-id "http://www.isidor.us/unittests/reification-xtm2.0-tests")) + (let ((dir "data_base") + (output-file "__out__.xtm") + (tm-id "http://www.isidor.us/unittests/reification-xtm2.0-tests")) (with-fixture initialize-destination-db (dir) + (base-tools:open-tm-store "data_base") + (make-construct 'TopicC :start-revision 100 + :psis + (list (make-construct 'PersistentIdC + :uri constants:*topic-name-psi*))) (handler-case (delete-file output-file) (error () )) ;do nothing (setf *TM-REVISION* 0) @@ -752,10 +768,9 @@ (test test-rdf-exporter-reification "Tests the reification in the rdf-exporter." - (let - ((dir "data_base") - (output-file "__out__.rdf") - (tm-id "http://simpsons.tv")) + (let ((dir "data_base") + (output-file "__out__.rdf") + (tm-id "http://simpsons.tv")) (setf *TM-REVISION* 0) (handler-case (delete-file output-file) (error () )) ;do nothing @@ -888,10 +903,9 @@ (test test-rdf-exporter-reification-3 "Tests the reification in the rdf-exporter." - (let - ((dir "data_base") - (output-file "__out__.rdf") - (tm-id "http://simpsons.tv")) + (let ((dir "data_base") + (output-file "__out__.rdf") + (tm-id "http://simpsons.tv")) (setf *TM-REVISION* 0) (handler-case (delete-file output-file) (error () )) ;do nothing @@ -923,10 +937,9 @@ (test test-rdf-exporter-reification-4 "Tests the reification in the rdf-exporter." - (let - ((dir "data_base") - (output-file "__out__.rdf") - (tm-id "http://simpsons.tv")) + (let ((dir "data_base") + (output-file "__out__.rdf") + (tm-id "http://simpsons.tv")) (setf *TM-REVISION* 0) (handler-case (delete-file output-file) (error () )) ;do nothing @@ -981,10 +994,9 @@ (test test-fragment-reification "Tests the reification in the rdf-exporter." - (let - ((dir "data_base") - (output-file "__out__.rdf") - (tm-id "http://simpsons.tv")) + (let ((dir "data_base") + (output-file "__out__.rdf") + (tm-id "http://simpsons.tv")) (setf *TM-REVISION* 0) (handler-case (delete-file output-file) (error () )) ;do nothing @@ -1016,17 +1028,4 @@ (defun run-reification-tests () - (it.bese.fiveam:run! 'test-merge-reifier-topics) - (it.bese.fiveam:run! 'test-xtm1.0-reification) - (it.bese.fiveam:run! 'test-xtm2.0-reification) - (it.bese.fiveam:run! 'test-xtm1.0-reification-exporter) - (it.bese.fiveam:run! 'test-xtm2.0-reification-exporter) - (it.bese.fiveam:run! 'test-rdf-importer-reification) - (it.bese.fiveam:run! 'test-rdf-importer-reification-2) - (it.bese.fiveam:run! 'test-rdf-importer-reification-3) - (it.bese.fiveam:run! 'test-rdf-importer-reification-4) - (it.bese.fiveam:run! 'test-rdf-exporter-reification) - (it.bese.fiveam:run! 'test-rdf-exporter-reification-2) - (it.bese.fiveam:run! 'test-rdf-exporter-reification-3) - (it.bese.fiveam:run! 'test-rdf-exporter-reification-4) - (it.bese.fiveam:run! 'test-fragment-reification)) \ No newline at end of file + (it.bese.fiveam:run! 'reification-test)) \ No newline at end of file Modified: trunk/src/unit_tests/sparql_test.lisp ============================================================================== --- trunk/src/unit_tests/sparql_test.lisp (original) +++ trunk/src/unit_tests/sparql_test.lisp Tue May 10 11:54:42 2011 @@ -2094,9 +2094,7 @@ (is-true (= (length r-1) 12)) (map 'list #'(lambda(item) (cond ((string= (getf item :variable) "pred1") - ;one name without a type so it is not listed - ;as regular triple but as tms:topicProperty - (is (= (length (getf item :result)) 17))) + (is (= (length (getf item :result)) 18))) ((string= (getf item :variable) "pred2") (is (= (length (getf item :result)) 3)) (is-false (set-exclusive-or @@ -2127,9 +2125,12 @@ (concat "<" *tms-scope* ">")) :test #'string=))) ((string= (getf item :variable) "obj1") - (is (= (length (getf item :result)) 17)) + (is (= (length (getf item :result)) 18)) (is-true (find "Johann Wolfgang" (getf item :result) :test #'tm-sparql::literal=)) + (is-true (find "Johann Wolfgang von Goethe" + (getf item :result) + :test #'tm-sparql::literal=)) (is-true (find "von Goethe" (getf item :result) :test #'tm-sparql::literal=)) (is-true (find t (getf item :result) Modified: trunk/src/xml/rdf/exporter.lisp ============================================================================== --- trunk/src/xml/rdf/exporter.lisp (original) +++ trunk/src/xml/rdf/exporter.lisp Tue May 10 11:54:42 2011 @@ -271,10 +271,16 @@ "Creates a set of properties. Everyone contains a reference to a scope topic." (declare ((or AssociationC OccurrenceC NameC VariantC RoleC) owner-construct)) - (map 'list #'(lambda(x) - (cxml:with-element "isi:scope" - (make-topic-reference x))) - (themes owner-construct))) + (let ((scopes + (if (typep owner-construct 'VariantC) + (set-difference (themes owner-construct) + (when-do name (parent owner-construct) + (themes name))) + (themes owner-construct)))) + (map 'list #'(lambda(x) + (cxml:with-element "isi:scope" + (make-topic-reference x))) + scopes))) (defun resourceX-to-rdf-elem (owner-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 11:54:42 2011 @@ -281,8 +281,12 @@ *rdf2tm-subject*)) (value-type-topic (get-item-by-psi *tm2rdf-value-property* :revision start-revision))) - (let ((scopes (get-players-by-role-type - scope-assocs start-revision *rdf2tm-object*)) + (let ((scopes + (remove-duplicates + (append (get-players-by-role-type + scope-assocs start-revision *rdf2tm-object*) + (when name + (themes name))))) (value-and-datatype (let ((value-occ (find-if #'(lambda(occ) Modified: trunk/src/xml/xtm/exporter.lisp ============================================================================== --- trunk/src/xml/xtm/exporter.lisp (original) +++ trunk/src/xml/xtm/exporter.lisp Tue May 10 11:54:42 2011 @@ -49,7 +49,7 @@ (when ,tm (to-reifier-elem ,tm ,revision) (map 'list #'(lambda(x) - (to-elem x ,revision)) + (to-elem x ,revision)) (item-identifiers ,tm :revision ,revision))) ,@body))) 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 11:54:42 2011 @@ -129,11 +129,15 @@ (declare (type (or integer nil) revision)) (cxml:with-element "t:variant" (to-reifier-elem-xtm1.0 variant revision) - (when (themes variant :revision revision) - (cxml:with-element "t:parameters" - (map 'list #'(lambda(x) - (to-topicRef-elem-xtm1.0 x revision)) - (themes variant :revision revision)))) + (let ((scopes + (set-difference (themes variant :revision revision) + (when-do name (instance-of variant :revision revision) + (themes name :revision revision))))) + (when scopes + (cxml:with-element "t:parameters" + (map 'list #'(lambda(x) + (to-topicRef-elem-xtm1.0 x revision)) + scopes)))) (cxml:with-element "t:variantName" (to-resourceX-elem-xtm1.0 variant revision)))) 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 11:54:42 2011 @@ -108,11 +108,15 @@ (map 'list #'(lambda(x) (to-elem x revision)) (item-identifiers variant :revision revision)) - (when (themes variant :revision revision) - (cxml:with-element "t:scope" - (map 'list #'(lambda(x) - (ref-to-elem x revision)) - (themes variant :revision revision)))) + (let ((scopes + (set-difference (themes variant :revision revision) + (when-do name (instance-of variant :revision revision) + (themes name :revision revision))))) + (when scopes + (cxml:with-element "t:scope" + (map 'list #'(lambda(x) + (ref-to-elem x revision)) + scopes)))) (to-resourceX-elem variant revision)))

1 0

[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