isidorus-cvs

isidorus-cvs@common-lisp.net

1037 discussions

[isidorus-cvs] r124 - trunk/src/unit_tests
by Lukas Giessmann 27 Aug '09

27 Aug '09

Author: lgiessmann Date: Thu Aug 27 10:34:22 2009 New Revision: 124 Log: json: updated isidorus, so it is possibiel to use the current cl-json module; fixed some unit tests for the json module which caused problems with the sbcl-slime-connection; updated some unit tests to the corresponding cl-json version Modified: trunk/src/unit_tests/json_test.lisp Modified: trunk/src/unit_tests/json_test.lisp ============================================================================== --- trunk/src/unit_tests/json_test.lisp (original) +++ trunk/src/unit_tests/json_test.lisp Thu Aug 27 10:34:22 2009 @@ -20,10 +20,23 @@ (:export :test-to-json-string-topics :test-to-json-string-associations :test-to-json-string-fragments - :test-get-fragment-values-from-json-list + :test-get-fragment-values-from-json-list-general + :test-get-fragment-values-from-json-list-names + :test-get-fragment-values-from-json-list-occurrences + :test-get-fragment-values-from-json-list-topicStubs + :test-get-fragment-values-from-json-list-associations :run-json-tests - :test-json-importer - :test-json-importer-merge + :test-json-importer-general-1 + :test-json-importer-general-2 + :test-json-importer-general-3 + :test-json-importer-topics-1 + :test-json-importer-topics-2 + :test-json-importer-topics-3 + :test-json-importer-topics-4 + :test-json-importer-associations + :test-json-importer-merge-1 + :test-json-importer-merge-2 + :test-json-importer-merge-3 :test-get-all-topic-psis)) @@ -36,6 +49,15 @@ (in-suite json-tests) +(defvar *t100-1* "{\"topic\":{\"id\":\"t970\",\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/standard/Common+Lisp\"],\"instanceOfs\":[[\"http://psi.egovpt.org/types/standard\"]],\"names\":[{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_n1\",\"http://www.egovpt.org/itemIdentifiers#t100_n1a\"],\"type\":null,\"scopes\":null,\"value\":\"Common Lisp\",\"variants\":[{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_n_v1\"],\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"],[\"http://psi.egovpt.org/types/long-name\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"Common-Lisp\"}}]}],\"occurrences\":[{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_o1\"],\"type\":[\"http://psi.egovpt.org/types/links\"],\"scopes\":null,\"resourceRef\":\"http://www.common-lisp.net/\",\"resourceData\":null}]},\"topicStubs\":[{\"id\":\"t220\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t3\",\"http://www.egovpt.org/itemIdentifiers#t3\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/standard\"]},{\"id\":\"t68\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"]},{\"id\":\"t284\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t50a\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/long-name\"]},{\"id\":\"t324\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t55\",\"http://psi.egovpt.org/itemIdentifiers#t55_1\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/links\"]}],\"associations\":null,\"tmIds\":[\"http://www.isidor.us/unittests/testtm\"]}") + +(defvar *t100-2* "{\"topic\":{\"id\":\"t945\",\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100\",\"http://www.egovpt.org/itemIdentifiers#t100_new\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/standard/Common+Lisp\"],\"instanceOfs\":[[\"http://psi.egovpt.org/types/standard\"]],\"names\":[{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_n1\"],\"type\":null,\"scopes\":null,\"value\":\"Common Lisp\",\"variants\":[{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_n_v1\"],\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"],[\"http://psi.egovpt.org/types/long-name\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"Common-Lisp\"}},{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_n_v2\"],\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#display\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"CL\"}}]}],\"occurrences\":[{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_o2\"],\"type\":[\"http://psi.egovpt.org/types/links\"],\"scopes\":null,\"resourceRef\":\"http://www.cliki.net/\",\"resourceData\":null}]},\"topicStubs\":[{\"id\":\"t220\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t3\",\"http://www.egovpt.org/itemIdentifiers#t3\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/standard\"]},{\"id\":\"t68\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"]},{\"id\":\"t284\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t50a\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/long-name\"]},{\"id\":\"t74\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm#display\"]},{\"id\":\"t324\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t55\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/links\"]}],\"associations\":null,\"tmIds\":[\"http://www.isidor.us/unittests/testtm\"]}") + +(defvar *t100-3* "{\"topic\":{\"id\":\"t404\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metada…"],\"instanceOfs\":[[\"http://psi.egovpt.org/types/semanticstandard\"]],\"names\":[{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_n1\"],\"type\":null,\"scopes\":null,\"value\":\"ISO 19115\",\"variants\":[{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_n1_v1\"],\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#display\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"Geographic Information - Metadata\"}},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_n1_v2\"],\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"ISO-19115\"}}]}],\"occurrences\":[{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_o1\"],\"type\":[\"http://psi.egovpt.org/types/standardHasStatus\"],\"scopes\":null,\"resourceRef\":\"http://www.budabe.de/\",\"resourceData\":null},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_o2\"],\"type\":[\"http://psi.egovpt.org/types/description\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"The ISO 19115 standard ...\"}},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_o3\"],\"type\":[\"http://psi.egovpt.org/types/standardValidFromDate\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#date\",\"value\":\"2003-01-01\"}},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_o4\"],\"type\":[\"http://psi.egovpt.org/types/links\"],\"scopes\":null,\"resourceRef\":\"http://www.editeur.org/standards/ISO19115.pdf\",\"resourceData\":null}]},\"topicStubs\":[{\"id\":\"t228\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t3a\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/semanticstandard\"]},{\"id\":\"t74\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm#display\"]},{\"id\":\"t68\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"]},{\"id\":\"t292\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t51\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/standardHasStatus\"]},{\"id\":\"t308\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t53\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/description\"]},{\"id\":\"t316\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t54\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/standardValidFromDate\"]},{\"id\":\"t324\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t55\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/links\"]},{\"id\":\"t434\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/subject/GeoData\"]},{\"id\":\"t364\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t60\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/standardIsAboutSubject\"]},{\"id\":\"t372\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t61\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/SubjectRoleType\"]},{\"id\":\"t422\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/subject/Semantic+Description\"]},{\"id\":\"t396\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t64\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/serviceUsesStandard\"]},{\"id\":\"t388\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t63\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/ServiceRoleType\"]},{\"id\":\"t452\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/service/Google+Maps\",\"http://maps.google.com\"]},{\"id\":\"t380\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t62\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/StandardRoleType\"]}],\"associations\":[{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/standardIsAboutSubject\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/StandardRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metada…"]},{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/SubjectRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/subject/GeoData\"]}]},{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/standardIsAboutSubject\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/StandardRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metada…"]},{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/SubjectRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/subject/Semantic+Description\"]}]},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#assoc_7\"],\"type\":[\"http://psi.egovpt.org/types/serviceUsesStandard\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/ServiceRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/service/Google+Maps\",\"http://maps.google.com\"]},{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/StandardRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metada…"]}]}],\"tmIds\":[\"http://www.isidor.us/unittests/testtm\"]}") + +(defvar *t64* "{\"topic\":{\"id\":\"t396\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t64\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/serviceUsesStandard\"],\"instanceOfs\":[[\"http://www.networkedplanet.com/psi/npcl/meta-types/association-type\"]],\"names\":[{\"itemIdentities\":null,\"type\":null,\"scopes\":null,\"value\":\"service uses standard\",\"variants\":null}],\"occurrences\":null},\"topicStubs\":[{\"id\":\"t260\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t7\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.networkedplanet.com/psi/npcl/meta-types/association-type\"]}],\"associations\":null,\"tmIds\":[\"http://www.isidor.us/unittests/testtm\"]}") + + (test test-to-json-string-topics (let ((dir "data_base")) @@ -48,31 +70,30 @@ (let ((t50a (get-item-by-id "t50a"))) (let ((t50a-string (to-json-string t50a)) (json-string - (concatenate 'string "{\"id\":\"" (topicid t50a) "\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t50a\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/long-name\"],\"instanceOfs\":[[\"http://www.networkedplanet.com/psi/npcl/meta-types/occurrence-type\"]],\"names\":[{\"itemIdentities\":null,\"type\":null,\"scopes\":null,\"value\":\"long version of a name\",\"variants\":[{\"itemIdentities\":null,\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"Long-Version\"}}]}],\"occurrences\":null}" ))) + (concatenate 'string "{\"id\":\"" (topicid t50a) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t50a\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/long-name\"],\"instanceOfs\":[[\"http:\\/\\/www.networkedplanet.com\\/psi\\/npcl\\/meta-types\\/occurrence-type\"]],\"names\":[{\"itemIdentities\":null,\"type\":null,\"scopes\":null,\"value\":\"long version of a name\",\"variants\":[{\"itemIdentities\":null,\"scopes\":[[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#sort\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"Long-Version\"}}]}],\"occurrences\":null}" ))) (is (string= t50a-string json-string))) (let ((t8 (get-item-by-id "t8"))) (let ((t8-string (to-json-string t8)) (json-string - (concatenate 'string "{\"id\":\"" (topicid t8) "\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t8\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.networkedplanet.com/psi/npcl/meta-types/association-role-type\"],\"instanceOfs\":[[\"http://www.networkedplanet.com/psi/npcl/meta-types/topic-type\"]],\"names\":[{\"itemIdentities\":null,\"type\":null,\"scopes\":null,\"value\":\"Association Role Type\",\"variants\":null}],\"occurrences\":null}"))) + (concatenate 'string "{\"id\":\"" (topicid t8) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t8\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/www.networkedplanet.com\\/psi\\/npcl\\/meta-types\\/association-role-type\"],\"instanceOfs\":[[\"http:\\/\\/www.networkedplanet.com\\/psi\\/npcl\\/meta-types\\/topic-type\"]],\"names\":[{\"itemIdentities\":null,\"type\":null,\"scopes\":null,\"value\":\"Association Role Type\",\"variants\":null}],\"occurrences\":null}"))) (is (string= t8-string json-string)))) (let ((t-topic (get-item-by-id "topic" :xtm-id "core.xtm"))) (let ((t-topic-string (to-json-string t-topic)) (json-string - (concatenate 'string "{\"id\":\"" (topicid t-topic) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm#topic\"],\"instanceOfs\":null,\"names\":null,\"occurrences\":null}"))) + (concatenate 'string "{\"id\":\"" (topicid t-topic) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#topic\"],\"instanceOfs\":null,\"names\":null,\"occurrences\":null}"))) (is (string= t-topic-string json-string)))) (let ((t301 (get-item-by-id "t301"))) (let ((t301-string (to-json-string t301)) (json-string - (concatenate 'string "{\"id\":\"" (topicid t301) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/service/Google+Maps\",\"http://maps.google.com\"],\"instanceOfs\":[[\"http://psi.egovpt.org/types/service\"]],\"names\":[{\"itemIdentities\":[\"http://psi.egovpt.org/topic/t301a_n1\"],\"type\":null,\"scopes\":[[\"http://psi.egovpt.org/types/long-name\"]],\"value\":\"Google Maps\",\"variants\":null},{\"itemIdentities\":null,\"type\":null,\"scopes\":[[\"http://psi.egovpt.org/types/long-name\"]],\"value\":\"Google Maps Application\",\"variants\":null}],\"occurrences\":[{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/description\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"a popular geodata service that is widely used for mashups with geodataProbably not really conformant to ISO 19115, but who cares in this context.\"}},{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/links\"],\"scopes\":null,\"resourceRef\":\"http://maps.google.com\",\"resourceData\":null},{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/links\"],\"scopes\":null,\"resourceRef\":\"http://maps.google.de\",\"resourceData\":null}]}"))) + (concatenate 'string "{\"id\":\"" (topicid t301) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/service\\/Google+Maps\",\"http:\\/\\/maps.google.com\"],\"instanceOfs\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/service\"]],\"names\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/topic\\/t301a_n1\"],\"type\":null,\"scopes\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/long-name\"]],\"value\":\"Google Maps\",\"variants\":null},{\"itemIdentities\":null,\"type\":null,\"scopes\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/long-name\"]],\"value\":\"Google Maps Application\",\"variants\":null}],\"occurrences\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/description\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"a popular geodata service that is widely used for mashups with geodataProbably not really conformant to ISO 19115, but who cares in this context.\"}},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/links\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/maps.google.com\",\"resourceData\":null},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/links\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/maps.google.de\",\"resourceData\":null}]}"))) (is (string= t301-string json-string)))) (let ((t100 (get-item-by-id "t100"))) (let ((t100-string (to-json-string t100)) (json-string - (concatenate 'string "{\"id\":\"" (topicid t100) "\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metada…"],\"instanceOfs\":[[\"http://psi.egovpt.org/types/semanticstandard\"]],\"names\":[{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_n1\"],\"type\":null,\"scopes\":null,\"value\":\"ISO 19115\",\"variants\":[{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_n1_v1\"],\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#display\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"Geographic Information - Metadata\"}},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_n1_v2\"],\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"ISO-19115\"}}]}],\"occurrences\":[{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_o1\"],\"type\":[\"http://psi.egovpt.org/types/standardHasStatus\"],\"scopes\":null,\"resourceRef\":\"http://www.budabe.de/\",\"resourceData\":null},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_o2\"],\"type\":[\"http://psi.egovpt.org/types/description\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"The ISO 19115 standard ...\"}},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_o3\"],\"type\":[\"http://psi.egovpt.org/types/standardValidFromDate\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#date\",\"value\":\"2003-01-01\"}},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_o4\"],\"type\":[\"http://psi.egovpt.org/types/links\"],\"scopes\":null,\"resourceRef\":\"http://www.editeur.org/standards/ISO19115.pdf\",\"resourceData\":null}]}"))) + (concatenate 'string "{\"id\":\"" (topicid t100) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"],\"instanceOfs\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/semanticstandard\"]],\"names\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1\"],\"type\":null,\"scopes\":null,\"value\":\"ISO 19115\",\"variants\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1_v1\"],\"scopes\":[[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#display\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"Geographic Information - Metadata\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1_v2\"],\"scopes\":[[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#sort\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"ISO-19115\"}}]}],\"occurrences\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o1\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardHasStatus\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/www.budabe.de\\/\",\"resourceData\":null},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o2\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/description\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"The ISO 19115 standard ...\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o3\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardValidFromDate\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#date\",\"value\":\"2003-01-01\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o4\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/links\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/www.editeur.org\\/standards\\/ISO19115.pdf\",\"resourceData\":null}]}"))) (is (string= t100-string json-string)))))))) - (test test-to-json-string-associations (let ((dir "data_base")) @@ -103,11 +124,11 @@ "http://psi.egovpt.org/itemIdentifiers#assoc_7")))) (let ((association-1-string (to-json-string association-1)) (json-string - (concatenate 'string "{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/isNarrowerSubject\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/broaderSubject\"],\"topicRef\":[\"http://psi.egovpt.org/subject/Data\"]},{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/narrowerSubject\"],\"topicRef\":[\"http://psi.egovpt.org/subject/GeoData\"]}]}"))) + (concatenate 'string "{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/isNarrowerSubject\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/broaderSubject\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/subject\\/Data\"]},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/narrowerSubject\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/subject\\/GeoData\"]}]}"))) (is (string= association-1-string json-string))) (let ((association-7-string (to-json-string association-7)) (json-string - (concatenate 'string "{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#assoc_7\"],\"type\":[\"http://psi.egovpt.org/types/serviceUsesStandard\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/ServiceRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/service/Google+Maps\",\"http://maps.google.com\"]},{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/StandardRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metada…"]}]}"))) + (concatenate 'string "{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#assoc_7\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/serviceUsesStandard\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/ServiceRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/service\\/Google+Maps\",\"http:\\/\\/maps.google.com\"]},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/StandardRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"]}]}"))) (is (string= association-7-string json-string))) (elephant:remove-association association-7 'roles (first (roles association-7))) (elephant:remove-association association-7 'roles (first (roles association-7))) @@ -116,11 +137,10 @@ (elephant:add-association association-7 'themes t62) (let ((association-7-string (to-json-string association-7)) (json-string - (concatenate 'string "{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#assoc_7\"],\"type\":null,\"scopes\":[[\"http://psi.egovpt.org/types/StandardRoleType\"],[\"http://psi.egovpt.org/types/serviceUsesStandard\"]],\"roles\":null}"))) + (concatenate 'string "{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#assoc_7\"],\"type\":null,\"scopes\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/StandardRoleType\"],[\"http:\\/\\/psi.egovpt.org\\/types\\/serviceUsesStandard\"]],\"roles\":null}"))) (is (string= association-7-string json-string)))))))) - (test test-to-json-string-fragments (let ((dir "data_base")) @@ -136,21 +156,20 @@ (frag-topic (create-latest-fragment-of-topic "http://www.topicmaps.org/xtm/1.0/core.xtm#topic"))) (let ((frag-t100-string - (concatenate 'string "{\"topic\":{\"id\":\"" (d:topicid (d:topic frag-t100)) "\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metada…"],\"instanceOfs\":[[\"http://psi.egovpt.org/types/semanticstandard\"]],\"names\":[{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_n1\"],\"type\":null,\"scopes\":null,\"value\":\"ISO 19115\",\"variants\":[{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_n1_v1\"],\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#display\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"Geographic Information - Metadata\"}},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_n1_v2\"],\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"ISO-19115\"}}]}],\"occurrences\":[{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_o1\"],\"type\":[\"http://psi.egovpt.org/types/standardHasStatus\"],\"scopes\":null,\"resourceRef\":\"http://www.budabe.de/\",\"resourceData\":null},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_o2\"],\"type\":[\"http://psi.egovpt.org/types/description\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"The ISO 19115 standard ...\"}},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_o3\"],\"type\":[\"http://psi.egovpt.org/types/standardValidFromDate\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#date\",\"value\":\"2003-01-01\"}},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_o4\"],\"type\":[\"http://psi.egovpt.org/types/links\"],\"scopes\":null,\"resourceRef\":\"http://www.editeur.org/standards/ISO19115.pdf\",\"resourceData\":null}]},\"topicStubs\":[{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 0)) "\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t3a\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/semanticstandard\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 1)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm#display\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 2)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 3)) "\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t51\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/standardHasStatus\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 4)) "\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t53\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/description\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 5)) "\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t54\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/standardValidFromDate\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 6)) "\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t55\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/links\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 7)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/subject/GeoData\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 8)) "\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t60\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/standardIsAboutSubject\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 9)) "\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t61\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/SubjectRoleType\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 10)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/subject/Semantic+Description\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 11)) "\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t64\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/serviceUsesStandard\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 12)) "\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t63\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/ServiceRoleType\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 13)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/service/Google+Maps\",\"http://maps.google.com\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 14)) "\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t62\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/StandardRoleType\"]}],\"associations\":[{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/standardIsAboutSubject\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/StandardRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metada…"]},{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/SubjectRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/subject/GeoData\"]}]},{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/standardIsAboutSubject\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/StandardRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metada…"]},{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/SubjectRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/subject/Semantic+Description\"]}]},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#assoc_7\"],\"type\":[\"http://psi.egovpt.org/types/serviceUsesStandard\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/ServiceRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/service/Google+Maps\",\"http://maps.google.com\"]},{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/StandardRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metada…"]}]}],\"tmIds\":[\"http://www.isidor.us/unittests/testtm\"]}")) + (concatenate 'string "{\"topic\":{\"id\":\"" (d:topicid (d:topic frag-t100)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"],\"instanceOfs\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/semanticstandard\"]],\"names\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1\"],\"type\":null,\"scopes\":null,\"value\":\"ISO 19115\",\"variants\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1_v1\"],\"scopes\":[[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#display\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"Geographic Information - Metadata\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1_v2\"],\"scopes\":[[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#sort\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"ISO-19115\"}}]}],\"occurrences\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o1\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardHasStatus\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/www.budabe.de\\/\",\"resourceData\":null},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o2\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/description\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"The ISO 19115 standard ...\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o3\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardValidFromDate\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#date\",\"value\":\"2003-01-01\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o4\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/links\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/www.editeur.org\\/standards\\/ISO19115.pdf\",\"resourceData\":null}]},\"topicStubs\":[{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 0)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t3a\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/semanticstandard\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 1)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#display\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 2)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#sort\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 3)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t51\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardHasStatus\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 4)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t53\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/description\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 5)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t54\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardValidFromDate\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 6)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t55\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/links\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 7)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/subject\\/GeoData\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 8)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t60\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardIsAboutSubject\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 9)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t61\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/SubjectRoleType\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 10)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/subject\\/Semantic+Description\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 11)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t64\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/serviceUsesStandard\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 12)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t63\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/ServiceRoleType\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 13)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/service\\/Google+Maps\",\"http:\\/\\/maps.google.com\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 14)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t62\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/StandardRoleType\"]}],\"associations\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardIsAboutSubject\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/StandardRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"]},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/SubjectRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/subject\\/GeoData\"]}]},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardIsAboutSubject\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/StandardRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"]},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/SubjectRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/subject\\/Semantic+Description\"]}]},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#assoc_7\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/serviceUsesStandard\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/ServiceRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/service\\/Google+Maps\",\"http:\\/\\/maps.google.com\"]},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/StandardRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"]}]}],\"tmIds\":[\"http:\\/\\/www.isidor.us\\/unittests\\/testtm\"]}")) (frag-topic-string - (concatenate 'string "{\"topic\":{\"id\":\"" (topicid (topic frag-topic)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm#topic\"],\"instanceOfs\":null,\"names\":null,\"occurrences\":null},\"topicStubs\":null,\"associations\":null,\"tmIds\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm\"]}"))) + (concatenate 'string "{\"topic\":{\"id\":\"" (topicid (topic frag-topic)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#topic\"],\"instanceOfs\":null,\"names\":null,\"occurrences\":null},\"topicStubs\":null,\"associations\":null,\"tmIds\":[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm\"]}"))) (is (string= frag-t100-string (to-json-string frag-t100))) (is (string= frag-topic-string (to-json-string frag-topic)))))))) - -(test test-get-fragment-values-from-json-list +(test test-get-fragment-values-from-json-list-general (let ((dir "data_base")) (with-fixture initialize-destination-db (dir) (xml-importer:setup-repository *notificationbase.xtm* dir :tm-id "http://www.isidor.us/unittests/testtm" - :xtm-id *TEST-TM*) + :xtm-id *TEST-TM*) (elephant:open-store (xml-importer:get-store-spec dir)) (let ((json-fragment @@ -160,22 +179,39 @@ (let ((fragment-list (json-importer::get-fragment-values-from-json-list (json:decode-json-from-string json-fragment)))) - (let ((topic (getf fragment-list :topic)) - (topicStubs (getf fragment-list :topicStubs)) - (f-associations (getf fragment-list :associations))) + (let ((topic (getf fragment-list :topic))) (is (string= (getf topic :ID) (d:topicid (d:identified-construct (elephant:get-instance-by-value 'd:PersistentIdC 'd:uri - "http://psi.egovpt.org/standard/Topic+Maps+2002"))))) + "http://psi.egovpt.org/standard/Topic+Maps+2002"))))) (is-false (getf topic :itemIdentities)) (is-false (getf topic :subjectLocators)) (is (= (length (getf topic :subjectIdentifiers)) 1)) - (is (string= (first (getf topic :subjectIdentifiers)) + (is (string= (first (getf topic :subjectIdentifiers)) "http://psi.egovpt.org/standard/Topic+Maps+2002")) - (is (= (length (getf topic :instanceOfs)) 1)) - (is (= (length (first (getf topic :instanceOfs))) 1)) - (is (string= (first (first (getf topic :instanceOfs))) - "http://psi.egovpt.org/types/semanticstandard")) + (is (= (length (getf topic :instanceOfs)) 1)) + (is (= (length (first (getf topic :instanceOfs))) 1)) + (is (string= (first (first (getf topic :instanceOfs))) + "http://psi.egovpt.org/types/semanticstandard")))))))) + + +(test test-get-fragment-values-from-json-list-names + (let + ((dir "data_base")) + (with-fixture initialize-destination-db (dir) + (xml-importer:setup-repository + *notificationbase.xtm* dir :tm-id "http://www.isidor.us/unittests/testtm" + :xtm-id *TEST-TM*) + + (elephant:open-store (xml-importer:get-store-spec dir)) + (let ((json-fragment + (let ((fragment-obj + (create-latest-fragment-of-topic "http://psi.egovpt.org/standard/Topic+Maps+2002"))) + (to-json-string fragment-obj)))) + (let ((fragment-list + (json-importer::get-fragment-values-from-json-list + (json:decode-json-from-string json-fragment)))) + (let ((topic (getf fragment-list :topic))) (is (= (length (getf topic :names)) 2)) (let ((name-1 (first (getf topic :names))) (name-2 (second (getf topic :names)))) @@ -223,8 +259,27 @@ (is (string= (getf (getf variant :resourceData) :datatype) "http://www.w3.org/2001/XMLSchema#string")) (is (string= (getf (getf variant :resourceData) :value) - "ISO/IEC-13250:2002")) - (is (= (length (getf topic :occurrences)) 4)))) + "ISO/IEC-13250:2002")))))))))) + + +(test test-get-fragment-values-from-json-list-occurrences + (let + ((dir "data_base")) + (with-fixture initialize-destination-db (dir) + (xml-importer:setup-repository + *notificationbase.xtm* dir :tm-id "http://www.isidor.us/unittests/testtm" + :xtm-id *TEST-TM*) + + (elephant:open-store (xml-importer:get-store-spec dir)) + (let ((json-fragment + (let ((fragment-obj + (create-latest-fragment-of-topic "http://psi.egovpt.org/standard/Topic+Maps+2002"))) + (to-json-string fragment-obj)))) + (let ((fragment-list + (json-importer::get-fragment-values-from-json-list + (json:decode-json-from-string json-fragment)))) + (let ((topic (getf fragment-list :topic))) + (is (= (length (getf topic :occurrences)) 4)) (let ((occurrence-1 (first (getf topic :occurrences))) (occurrence-2 (second (getf topic :occurrences))) (occurrence-3 (third (getf topic :occurrences))) @@ -267,7 +322,26 @@ (is-false (getf occurrence-4 :scopes)) (is (string= (getf occurrence-4 :resourceRef) "http://www1.y12.doe.gov/capabilities/sgml/sc34/document/0322_files/iso13250…")) - (is-false (getf occurrence-4 :resourceData))) + (is-false (getf occurrence-4 :resourceData))))))))) + + +(test test-get-fragment-values-from-json-list-topicStubs + (let + ((dir "data_base")) + (with-fixture initialize-destination-db (dir) + (xml-importer:setup-repository + *notificationbase.xtm* dir :tm-id "http://www.isidor.us/unittests/testtm" + :xtm-id *TEST-TM*) + + (elephant:open-store (xml-importer:get-store-spec dir)) + (let ((json-fragment + (let ((fragment-obj + (create-latest-fragment-of-topic "http://psi.egovpt.org/standard/Topic+Maps+2002"))) + (to-json-string fragment-obj)))) + (let ((fragment-list + (json-importer::get-fragment-values-from-json-list + (json:decode-json-from-string json-fragment)))) + (let ((topicStubs (getf fragment-list :topicStubs))) (is (= (length topicStubs) 15)) (loop for topicStub in topicStubs do (let ((id (getf topicStub :ID)) @@ -340,7 +414,27 @@ (is (string= (first itemIdentities) "http://psi.egovpt.org/itemIdentifiers#t52"))) (t - (is-true (format t "bad subjectIdentifier found in topicStubs")))))))) + (is-true (format t "bad subjectIdentifier found in topicStubs")))))))))))))) + + + +(test test-get-fragment-values-from-json-list-associations + (let + ((dir "data_base")) + (with-fixture initialize-destination-db (dir) + (xml-importer:setup-repository + *notificationbase.xtm* dir :tm-id "http://www.isidor.us/unittests/testtm" + :xtm-id *TEST-TM*) + + (elephant:open-store (xml-importer:get-store-spec dir)) + (let ((json-fragment + (let ((fragment-obj + (create-latest-fragment-of-topic "http://psi.egovpt.org/standard/Topic+Maps+2002"))) + (to-json-string fragment-obj)))) + (let ((fragment-list + (json-importer::get-fragment-values-from-json-list + (json:decode-json-from-string json-fragment)))) + (let ((f-associations (getf fragment-list :associations))) (is (= (length f-associations) 2)) (is (= (length (getf (first f-associations) :type)) 1)) (is (= (length (getf (second f-associations) :type)) 1)) @@ -396,147 +490,192 @@ "http://psi.egovpt.org/standard/Topic+Maps+2002")))))))))) -(test test-json-importer +(test test-json-importer-general-1 (let ((dir "data_base")) (with-fixture initialize-destination-db (dir) (elephant:open-store (xml-importer:get-store-spec dir)) (xml-importer:init-isidorus) (elephant:open-store (xml-importer:get-store-spec dir)) ; init-isiodurs closes the store - - (let ((json-fragment-t64 - "{\"topic\":{\"id\":\"t396\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t64\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/serviceUsesStandard\"],\"instanceOfs\":[[\"http://www.networkedplanet.com/psi/npcl/meta-types/association-type\"]],\"names\":[{\"itemIdentities\":null,\"type\":null,\"scopes\":null,\"value\":\"service uses standard\",\"variants\":null}],\"occurrences\":null},\"topicStubs\":[{\"id\":\"t260\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t7\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.networkedplanet.com/psi/npcl/meta-types/association-type\"]}],\"associations\":null,\"tmIds\":[\"http://www.isidor.us/unittests/testtm\"]}") - (json-fragment-t100 - "{\"topic\":{\"id\":\"t404\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metada…"],\"instanceOfs\":[[\"http://psi.egovpt.org/types/semanticstandard\"]],\"names\":[{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_n1\"],\"type\":null,\"scopes\":null,\"value\":\"ISO 19115\",\"variants\":[{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_n1_v1\"],\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#display\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"Geographic Information - Metadata\"}},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_n1_v2\"],\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"ISO-19115\"}}]}],\"occurrences\":[{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_o1\"],\"type\":[\"http://psi.egovpt.org/types/standardHasStatus\"],\"scopes\":null,\"resourceRef\":\"http://www.budabe.de/\",\"resourceData\":null},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_o2\"],\"type\":[\"http://psi.egovpt.org/types/description\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"The ISO 19115 standard ...\"}},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_o3\"],\"type\":[\"http://psi.egovpt.org/types/standardValidFromDate\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#date\",\"value\":\"2003-01-01\"}},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_o4\"],\"type\":[\"http://psi.egovpt.org/types/links\"],\"scopes\":null,\"resourceRef\":\"http://www.editeur.org/standards/ISO19115.pdf\",\"resourceData\":null}]},\"topicStubs\":[{\"id\":\"t228\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t3a\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/semanticstandard\"]},{\"id\":\"t74\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm#display\"]},{\"id\":\"t68\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"]},{\"id\":\"t292\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t51\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/standardHasStatus\"]},{\"id\":\"t308\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t53\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/description\"]},{\"id\":\"t316\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t54\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/standardValidFromDate\"]},{\"id\":\"t324\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t55\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/links\"]},{\"id\":\"t434\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/subject/GeoData\"]},{\"id\":\"t364\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t60\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/standardIsAboutSubject\"]},{\"id\":\"t372\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t61\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/SubjectRoleType\"]},{\"id\":\"t422\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/subject/Semantic+Description\"]},{\"id\":\"t396\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t64\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/serviceUsesStandard\"]},{\"id\":\"t388\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t63\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/ServiceRoleType\"]},{\"id\":\"t452\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/service/Google+Maps\",\"http://maps.google.com\"]},{\"id\":\"t380\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t62\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/StandardRoleType\"]}],\"associations\":[{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/standardIsAboutSubject\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/StandardRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metada…"]},{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/SubjectRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/subject/GeoData\"]}]},{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/standardIsAboutSubject\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/StandardRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metada…"]},{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/SubjectRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/subject/Semantic+Description\"]}]},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#assoc_7\"],\"type\":[\"http://psi.egovpt.org/types/serviceUsesStandard\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/ServiceRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/service/Google+Maps\",\"http://maps.google.com\"]},{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/StandardRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metada…"]}]}],\"tmIds\":[\"http://www.isidor.us/unittests/testtm\"]}")) - (is (= (length (elephant:get-instances-by-class 'TopicC)) 13)) - (is (= (length (elephant:get-instances-by-class 'AssociationC)) 0)) - (is (= (length (elephant:get-instances-by-class 'TopicMapC)) 1)) - (json-importer:json-to-elem json-fragment-t64) - (is (= (length (elephant:get-instances-by-class 'TopicC)) 15)) - (is (= (length (elephant:get-instances-by-class 'AssociationC)) 1)) - (is (= (length (elephant:get-instances-by-class 'TopicMapC)) 2)) - (let ((core-tm - (loop for tm in (elephant:get-instances-by-class 'TopicMapC) - when (string= (uri (first (item-identifiers tm))) - "http://www.topicmaps.org/xtm/1.0/core.xtm") - return tm)) - (test-tm - (loop for tm in (elephant:get-instances-by-class 'TopicMapC) - when (string= (uri (first (item-identifiers tm))) - "http://www.isidor.us/unittests/testtm") - return tm))) - (is-true (and core-tm test-tm)) - (is (= (length (topics core-tm)) 13)) - (is (= (length (associations core-tm)) 0)) - (is (= (length (topics test-tm)) 2)) - (is (= (length (associations test-tm)) 1)) - (let ((main-topic - (loop for topic in (topics test-tm) - when (string= (uri (first (psis topic))) - "http://psi.egovpt.org/types/serviceUsesStandard") - return topic)) - (sub-topic - (loop for topic in (topics test-tm) - when (string= (uri (first (psis topic))) - "http://www.networkedplanet.com/psi/npcl/meta-types/association-type") - return topic))) - (is-true (and main-topic sub-topic)) - (let ((instanceOf-assoc - (first (associations test-tm)))) - (is (string= (uri (first (psis (instance-of instanceOf-assoc)))) - constants::*type-instance-psi*)) - (is-false (d:themes instanceOf-assoc)) - (is (string= (d:uri (first (d:item-identifiers (first (d:in-topicmaps instanceOf-assoc))))) - "http://www.isidor.us/unittests/testtm")) - (is-false (d:item-identifiers instanceOf-assoc)) - (let ((super-type-role - (loop for role in (roles instanceOf-assoc) - when (string= (uri (first (psis (instance-of role)))) - constants:*type-psi*) - return role)) - (sub-type-role - (loop for role in (roles instanceOf-assoc) - when (string= (uri (first (psis (instance-of role)))) - constants:*instance-psi*) - return role))) - (is-true (and super-type-role sub-type-role)) - (is (string= (uri (first (psis (player super-type-role)))) - "http://www.networkedplanet.com/psi/npcl/meta-types/association-type")) - (is (string= (uri (first (psis (player sub-type-role)))) - "http://psi.egovpt.org/types/serviceUsesStandard")))) - (is-true (= (length (item-identifiers main-topic)) 1)) - (is-true (= (length (item-identifiers sub-topic)) 1)) - (is-true (string= (uri (first (item-identifiers main-topic))) - "http://psi.egovpt.org/itemIdentifiers#t64")) - (is-true (string= (uri (first (item-identifiers sub-topic))) - "http://psi.egovpt.org/itemIdentifiers#t7")) - (is-true (= (length (names main-topic)) 1)) - (is-true (string= (charvalue (first (names main-topic))) - "service uses standard")))) - (json-importer:json-to-elem json-fragment-t100) - (is (= (length (elephant:get-instances-by-class 'TopicC)) 28)) ;13 new topics - (is (= (length (elephant:get-instances-by-class 'AssociationC)) 5)) ;4 new associations - (is (= (length (elephant:get-instances-by-class 'TopicMapC)) 2)) - (let ((core-tm - (loop for tm in (elephant:get-instances-by-class 'TopicMapC) - when (string= (uri (first (item-identifiers tm))) - "http://www.topicmaps.org/xtm/1.0/core.xtm") - return tm)) - (test-tm + (is (= (length (elephant:get-instances-by-class 'TopicC)) 13)) + (is (= (length (elephant:get-instances-by-class 'AssociationC)) 0)) + (is (= (length (elephant:get-instances-by-class 'TopicMapC)) 1)) + (json-importer:json-to-elem *t64*) + (is (= (length (elephant:get-instances-by-class 'TopicC)) 15)) + (is (= (length (elephant:get-instances-by-class 'AssociationC)) 1)) + (is (= (length (elephant:get-instances-by-class 'TopicMapC)) 2)) + (let ((core-tm + (loop for tm in (elephant:get-instances-by-class 'TopicMapC) + when (string= (uri (first (item-identifiers tm))) + "http://www.topicmaps.org/xtm/1.0/core.xtm") + return tm)) + (test-tm + (loop for tm in (elephant:get-instances-by-class 'TopicMapC) + when (string= (uri (first (item-identifiers tm))) + "http://www.isidor.us/unittests/testtm") + return tm))) + (is-true (and core-tm test-tm)) + (is (= (length (topics core-tm)) 13)) + (is (= (length (associations core-tm)) 0)) + (is (= (length (topics test-tm)) 2)) + (is (= (length (associations test-tm)) 1)))))) + + +(test test-json-importer-general-2 + (let + ((dir "data_base")) + (with-fixture initialize-destination-db (dir) + (elephant:open-store (xml-importer:get-store-spec dir)) + (xml-importer:init-isidorus) + (elephant:open-store (xml-importer:get-store-spec dir)) ; init-isiodurs closes the store + (json-importer:json-to-elem *t64*) + (let ((test-tm (loop for tm in (elephant:get-instances-by-class 'TopicMapC) when (string= (uri (first (item-identifiers tm))) "http://www.isidor.us/unittests/testtm") return tm))) - (is-true (and core-tm test-tm)) - (is (= (length (topics core-tm)) 13)) - (is (= (length (associations core-tm)) 0)) - (is (= (length (topics test-tm)) 17)) - (is (= (length (associations test-tm)) 5)) - (let ((topics (elephant:get-instances-by-class 'TopicC))) - (loop for topic in topics - do (let ((psi (uri (first (psis topic))))) - (cond - ((string= psi "http://psi.egovpt.org/types/semanticstandard") ;t3a - (is-false (names topic)) - (is-false (occurrences topic)) - (is-false (locators topic)) - (is (= (length (psis topic)) 1)) - (is (= (length (item-identifiers topic)) 1)) - (is (string= (uri (first (item-identifiers topic))) - "http://psi.egovpt.org/itemIdentifiers#t3a"))) - ((string= psi "http://www.networkedplanet.com/psi/npcl/meta-types/association-type") ;t7 - (is-false (names topic)) - (is-false (occurrences topic)) - (is-false (locators topic)) - (is (= (length (psis topic)) 1)) - (is (= (length (item-identifiers topic)) 1)) - (is (string= (uri (first (item-identifiers topic))) - "http://psi.egovpt.org/itemIdentifiers#t7"))) - ((string= psi "http://psi.egovpt.org/types/standardHasStatus") ;t51 - (is-false (names topic)) - (is-false (occurrences topic)) - (is-false (locators topic)) - (is (= (length (psis topic)) 1)) - (is (= (length (item-identifiers topic)) 1)) - (is (string= (uri (first (item-identifiers topic))) - "http://psi.egovpt.org/itemIdentifiers#t51"))) - ((string= psi "http://psi.egovpt.org/types/description") ;t53 - (is-false (names topic)) - (is-false (occurrences topic)) - (is-false (locators topic)) - (is (= (length (psis topic)) 1)) - (is (= (length (item-identifiers topic)) 1)) - (is (string= (uri (first (item-identifiers topic))) - "http://psi.egovpt.org/itemIdentifiers#t53"))) - ((string= psi "http://psi.egovpt.org/types/standardValidFromDate") ;t54 + (let ((main-topic + (loop for topic in (topics test-tm) + when (string= (uri (first (psis topic))) + "http://psi.egovpt.org/types/serviceUsesStandard") + return topic)) + (sub-topic + (loop for topic in (topics test-tm) + when (string= (uri (first (psis topic))) + "http://www.networkedplanet.com/psi/npcl/meta-types/association-type") + return topic))) + (is-true (and main-topic sub-topic)) + (let ((instanceOf-assoc + (first (associations test-tm)))) + (is (string= (uri (first (psis (instance-of instanceOf-assoc)))) + constants::*type-instance-psi*)) + (is-false (d:themes instanceOf-assoc)) + (is (string= (d:uri (first (d:item-identifiers (first (d:in-topicmaps instanceOf-assoc))))) + "http://www.isidor.us/unittests/testtm")) + (is-false (d:item-identifiers instanceOf-assoc)) + (let ((super-type-role + (loop for role in (roles instanceOf-assoc) + when (string= (uri (first (psis (instance-of role)))) + constants:*type-psi*) + return role)) + (sub-type-role + (loop for role in (roles instanceOf-assoc) + when (string= (uri (first (psis (instance-of role)))) + constants:*instance-psi*) + return role))) + (is-true (and super-type-role sub-type-role)) + (is (string= (uri (first (psis (player super-type-role)))) + "http://www.networkedplanet.com/psi/npcl/meta-types/association-type")) + (is (string= (uri (first (psis (player sub-type-role)))) + "http://psi.egovpt.org/types/serviceUsesStandard")))) + (is-true (= (length (item-identifiers main-topic)) 1)) + (is-true (= (length (item-identifiers sub-topic)) 1)) + (is-true (string= (uri (first (item-identifiers main-topic))) + "http://psi.egovpt.org/itemIdentifiers#t64")) + (is-true (string= (uri (first (item-identifiers sub-topic))) + "http://psi.egovpt.org/itemIdentifiers#t7")) + (is-true (= (length (names main-topic)) 1)) + (is-true (string= (charvalue (first (names main-topic))) + "service uses standard"))))))) + + +(test test-json-importer-general-3 + (let + ((dir "data_base")) + (with-fixture initialize-destination-db (dir) + (elephant:open-store (xml-importer:get-store-spec dir)) + (xml-importer:init-isidorus) + (elephant:open-store (xml-importer:get-store-spec dir)) ; init-isiodurs closes the store + (json-importer:json-to-elem *t64*) + (json-importer:json-to-elem *t100-3*) + (is (= (length (elephant:get-instances-by-class 'TopicC)) 28)) ;13 new topics + (is (= (length (elephant:get-instances-by-class 'AssociationC)) 5)) ;4 new associations + (is (= (length (elephant:get-instances-by-class 'TopicMapC)) 2)) + (let ((core-tm + (loop for tm in (elephant:get-instances-by-class 'TopicMapC) + when (string= (uri (first (item-identifiers tm))) + "http://www.topicmaps.org/xtm/1.0/core.xtm") + return tm)) + (test-tm + (loop for tm in (elephant:get-instances-by-class 'TopicMapC) + when (string= (uri (first (item-identifiers tm))) + "http://www.isidor.us/unittests/testtm") + return tm))) + (is-true (and core-tm test-tm)) + (is (= (length (topics core-tm)) 13)) + (is (= (length (associations core-tm)) 0)) + (is (= (length (topics test-tm)) 17)) + (is (= (length (associations test-tm)) 5)))))) + + +(test test-json-importer-topics-1 + (let + ((dir "data_base")) + (with-fixture initialize-destination-db (dir) + (elephant:open-store (xml-importer:get-store-spec dir)) + (xml-importer:init-isidorus) + (elephant:open-store (xml-importer:get-store-spec dir)) ; init-isiodurs closes the store + (json-importer:json-to-elem *t64*) + (json-importer:json-to-elem *t100-3*) + (let ((topics (elephant:get-instances-by-class 'TopicC))) + (loop for topic in topics + do (let ((psi (uri (first (psis topic))))) + (cond + ((string= psi "http://psi.egovpt.org/types/semanticstandard") ;t3a + (is-false (names topic)) + (is-false (occurrences topic)) + (is-false (locators topic)) + (is (= (length (psis topic)) 1)) + (is (= (length (item-identifiers topic)) 1)) + (is (string= (uri (first (item-identifiers topic))) + "http://psi.egovpt.org/itemIdentifiers#t3a"))) + ((string= psi "http://www.networkedplanet.com/psi/npcl/meta-types/association-type") ;t7 + (is-false (names topic)) + (is-false (occurrences topic)) + (is-false (locators topic)) + (is (= (length (psis topic)) 1)) + (is (= (length (item-identifiers topic)) 1)) + (is (string= (uri (first (item-identifiers topic))) + "http://psi.egovpt.org/itemIdentifiers#t7"))) + ((string= psi "http://psi.egovpt.org/types/standardHasStatus") ;t51 + (is-false (names topic)) + (is-false (occurrences topic)) + (is-false (locators topic)) + (is (= (length (psis topic)) 1)) + (is (= (length (item-identifiers topic)) 1)) + (is (string= (uri (first (item-identifiers topic))) + "http://psi.egovpt.org/itemIdentifiers#t51"))) + ((string= psi "http://psi.egovpt.org/types/description") ;t53 + (is-false (names topic)) + (is-false (occurrences topic)) + (is-false (locators topic)) + (is (= (length (psis topic)) 1)) + (is (= (length (item-identifiers topic)) 1)) + (is (string= (uri (first (item-identifiers topic))) + "http://psi.egovpt.org/itemIdentifiers#t53"))) + ((string= psi "http://psi.egovpt.org/types/standardValidFromDate") ;t54 (is-false (names topic)) (is-false (occurrences topic)) (is-false (locators topic)) (is (= (length (psis topic)) 1)) (is (= (length (item-identifiers topic)) 1)) (is (string= (uri (first (item-identifiers topic))) - "http://psi.egovpt.org/itemIdentifiers#t54"))) - ((string= psi "http://psi.egovpt.org/types/links") ;t55 + "http://psi.egovpt.org/itemIdentifiers#t54")))))))))) + + +(test test-json-importer-topics-2 + (let + ((dir "data_base")) + (with-fixture initialize-destination-db (dir) + (elephant:open-store (xml-importer:get-store-spec dir)) + (xml-importer:init-isidorus) + (elephant:open-store (xml-importer:get-store-spec dir)) ; init-isiodurs closes the store + (json-importer:json-to-elem *t64*) + (json-importer:json-to-elem *t100-3*) + (let ((topics (elephant:get-instances-by-class 'TopicC))) + (loop for topic in topics + do (let ((psi (uri (first (psis topic))))) + (cond ((string= psi "http://psi.egovpt.org/types/links") ;t55 (is-false (names topic)) (is-false (occurrences topic)) (is-false (locators topic)) @@ -585,8 +724,22 @@ (is (= (length (psis topic)) 1)) (is (= (length (item-identifiers topic)) 1)) (is (string= (uri (first (item-identifiers topic))) - "http://psi.egovpt.org/itemIdentifiers#t64"))) - ((string= psi "http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metada…") ;t100 + "http://psi.egovpt.org/itemIdentifiers#t64")))))))))) + + +(test test-json-importer-topics-3 + (let + ((dir "data_base")) + (with-fixture initialize-destination-db (dir) + (elephant:open-store (xml-importer:get-store-spec dir)) + (xml-importer:init-isidorus) + (elephant:open-store (xml-importer:get-store-spec dir)) ; init-isiodurs closes the store + (json-importer:json-to-elem *t64*) + (json-importer:json-to-elem *t100-3*) + (let ((topics (elephant:get-instances-by-class 'TopicC))) + (loop for topic in topics + do (let ((psi (uri (first (psis topic))))) + (cond ((string= psi "http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metada…") ;t100 (is (= (length (psis topic)) 1)) (is (= (length (item-identifiers topic)) 1)) (is (string= (uri (first (item-identifiers topic))) @@ -660,8 +813,22 @@ (is (string= (datatype occ-4) "http://www.w3.org/2001/XMLSchema#anyURI")) (is (string= (charvalue occ-4) - "http://www.editeur.org/standards/ISO19115.pdf")))) - ((string= psi "http://psi.egovpt.org/subject/Semantic+Description") ;t201 + "http://www.editeur.org/standards/ISO19115.pdf"))))))))))) + + +(test test-json-importer-topics-4 + (let + ((dir "data_base")) + (with-fixture initialize-destination-db (dir) + (elephant:open-store (xml-importer:get-store-spec dir)) + (xml-importer:init-isidorus) + (elephant:open-store (xml-importer:get-store-spec dir)) ; init-isiodurs closes the store + (json-importer:json-to-elem *t64*) + (json-importer:json-to-elem *t100-3*) + (let ((topics (elephant:get-instances-by-class 'TopicC))) + (loop for topic in topics + do (let ((psi (uri (first (psis topic))))) + (cond ((string= psi "http://psi.egovpt.org/subject/Semantic+Description") ;t201 (is-false (names topic)) (is-false (occurrences topic)) (is-false (locators topic)) @@ -687,256 +854,299 @@ "http://psi.egovpt.org/service/Google+Maps") (string= (uri (second (psis topic))) "http://maps.google.com"))) - (is-false (item-identifiers topic))) - (t - (if (or (string= psi "http://www.topicmaps.org/xtm/1.0/core.xtm#sort") - (string= psi "http://www.topicmaps.org/xtm/1.0/core.xtm#display")) - (progn - (is (= (length (in-topicmaps topic)) 2)) - (is (or (string= (uri (first (item-identifiers (first (in-topicmaps topic))))) - "http://www.topicmaps.org/xtm/1.0/core.xtm") - (string= (uri (first (item-identifiers (second (in-topicmaps topic))))) - "http://www.topicmaps.org/xtm/1.0/core.xtm"))) - (is (or (string= (uri (first (item-identifiers (first (in-topicmaps topic))))) - "http://www.isidor.us/unittests/testtm") - (string= (uri (first (item-identifiers (second (in-topicmaps topic))))) - "http://www.isidor.us/unittests/testtm")))) - (progn - (is (= (length (in-topicmaps topic)) 1)) - (is (string= (uri (first (item-identifiers (first (in-topicmaps topic))))) - "http://www.topicmaps.org/xtm/1.0/core.xtm"))))))))); - (let ((assoc-7 - (identified-construct - (elephant:get-instance-by-value 'ItemidentifierC 'uri - "http://psi.egovpt.org/itemIdentifiers#assoc_7")))) - (is (= (length (item-identifiers assoc-7)))) - (is (string= (uri (first (item-identifiers assoc-7))) - "http://psi.egovpt.org/itemIdentifiers#assoc_7")) - (is (= (length (roles assoc-7)) 2)) - (is (string= (uri (first (psis (instance-of assoc-7)))) - "http://psi.egovpt.org/types/serviceUsesStandard")) - (let ((role-1 (first (roles assoc-7))) - (role-2 (second (roles assoc-7)))) - (is (string= (uri (first (psis (instance-of role-1)))) - "http://psi.egovpt.org/types/ServiceRoleType")) - (is (or (string= (uri (first (psis (player role-1)))) - "http://psi.egovpt.org/service/Google+Maps") - (string= (uri (first (psis (player role-1)))) - "http://maps.google.com"))) - (is (string= (uri (first (psis (instance-of role-2)))) - "http://psi.egovpt.org/types/StandardRoleType")) - (is (string= (uri (first (psis (player role-2)))) - "http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metada…"))))))))) + (is-false (item-identifiers topic)))))))))) + - -(test test-json-importer-merge +(test test-json-importer-associations (let ((dir "data_base")) (with-fixture initialize-destination-db (dir) (elephant:open-store (xml-importer:get-store-spec dir)) (xml-importer:init-isidorus) (elephant:open-store (xml-importer:get-store-spec dir)) ; init-isiodurs closes the store - (let ((t100-1 "{\"topic\":{\"id\":\"t970\",\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/standard/Common+Lisp\"],\"instanceOfs\":[[\"http://psi.egovpt.org/types/standard\"]],\"names\":[{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_n1\",\"http://www.egovpt.org/itemIdentifiers#t100_n1a\"],\"type\":null,\"scopes\":null,\"value\":\"Common Lisp\",\"variants\":[{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_n_v1\"],\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"],[\"http://psi.egovpt.org/types/long-name\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"Common-Lisp\"}}]}],\"occurrences\":[{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_o1\"],\"type\":[\"http://psi.egovpt.org/types/links\"],\"scopes\":null,\"resourceRef\":\"http://www.common-lisp.net/\",\"resourceData\":null}]},\"topicStubs\":[{\"id\":\"t220\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t3\",\"http://www.egovpt.org/itemIdentifiers#t3\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/standard\"]},{\"id\":\"t68\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"]},{\"id\":\"t284\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t50a\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/long-name\"]},{\"id\":\"t324\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t55\",\"http://psi.egovpt.org/itemIdentifiers#t55_1\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/links\"]}],\"associations\":null,\"tmIds\":[\"http://www.isidor.us/unittests/testtm\"]}") - (t100-2 "{\"topic\":{\"id\":\"t945\",\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100\",\"http://www.egovpt.org/itemIdentifiers#t100_new\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/standard/Common+Lisp\"],\"instanceOfs\":[[\"http://psi.egovpt.org/types/standard\"]],\"names\":[{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_n1\"],\"type\":null,\"scopes\":null,\"value\":\"Common Lisp\",\"variants\":[{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_n_v1\"],\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"],[\"http://psi.egovpt.org/types/long-name\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"Common-Lisp\"}},{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_n_v2\"],\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#display\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"CL\"}}]}],\"occurrences\":[{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_o2\"],\"type\":[\"http://psi.egovpt.org/types/links\"],\"scopes\":null,\"resourceRef\":\"http://www.cliki.net/\",\"resourceData\":null}]},\"topicStubs\":[{\"id\":\"t220\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t3\",\"http://www.egovpt.org/itemIdentifiers#t3\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/standard\"]},{\"id\":\"t68\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"]},{\"id\":\"t284\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t50a\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/long-name\"]},{\"id\":\"t74\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm#display\"]},{\"id\":\"t324\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t55\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/links\"]}],\"associations\":null,\"tmIds\":[\"http://www.isidor.us/unittests/testtm\"]}")) - (is (= (length (elephant:get-instances-by-class 'TopicC)) 13)) - (is (= (length (elephant:get-instances-by-class 'AssociationC)) 0)) - (is (= (length (elephant:get-instances-by-class 'TopicMapC)) 1)) - (json-importer:json-to-elem t100-1) - (is (= (length (elephant:get-instances-by-class 'TopicC)) 17)) - (is (= (length (elephant:get-instances-by-class 'AssociationC)) 1)) - (is (= (length (elephant:get-instances-by-class 'TopicMapC)) 2)) - (let ((core-tm - (loop for tm in (elephant:get-instances-by-class 'TopicMapC) - when (string= (uri (first (item-identifiers tm))) - "http://www.topicmaps.org/xtm/1.0/core.xtm") - return tm)) - (test-tm - (loop for tm in (elephant:get-instances-by-class 'TopicMapC) - when (string= (uri (first (item-identifiers tm))) - "http://www.isidor.us/unittests/testtm") - return tm))) - (is-true (and core-tm test-tm))) - (json-importer:json-to-elem t100-2) - (is (= (length (elephant:get-instances-by-class 'TopicC)) 17)) - (is (= (length (elephant:get-instances-by-class 'AssociationC)) 1)) - (is (= (length (elephant:get-instances-by-class 'TopicMapC)) 2)) - (let ((core-tm - (loop for tm in (elephant:get-instances-by-class 'TopicMapC) - when (string= (uri (first (item-identifiers tm))) - "http://www.topicmaps.org/xtm/1.0/core.xtm") - return tm)) - (test-tm - (loop for tm in (elephant:get-instances-by-class 'TopicMapC) - when (string= (uri (first (item-identifiers tm))) - "http://www.isidor.us/unittests/testtm") - return tm))) - (is-true (and core-tm test-tm))) - (let ((topics (elephant:get-instances-by-class 'TopicC))) - (loop for topic in topics - do (let ((psi (uri (first (psis topic))))) - (cond - ((string= psi "http://psi.egovpt.org/types/standard") ;t3 - (is (= (length (in-topicmaps topic)) 1)) - (is (string= (uri (first (item-identifiers (first (in-topicmaps topic))))) - "http://www.isidor.us/unittests/testtm")) - (is-false (names topic)) - (is-false (occurrences topic)) - (is-false (locators topic)) - (is (= (length (psis topic)) 1)) - (is (= (length (item-identifiers topic)) 2)) - (is (or (string= (uri (first (item-identifiers topic))) - "http://www.egovpt.org/itemIdentifiers#t3") - (string= (uri (second (item-identifiers topic))) - "http://www.egovpt.org/itemIdentifiers#t3"))) - (is (or (string= (uri (first (item-identifiers topic))) - "http://psi.egovpt.org/itemIdentifiers#t3") - (string= (uri (second (item-identifiers topic))) - "http://psi.egovpt.org/itemIdentifiers#t3")))) - ((string= psi "http://psi.egovpt.org/types/long-name") ;t50a - (is (= (length (in-topicmaps topic)) 1)) - (is (string= (uri (first (item-identifiers (first (in-topicmaps topic))))) - "http://www.isidor.us/unittests/testtm")) - (is-false (names topic)) - (is-false (occurrences topic)) - (is-false (locators topic)) - (is (= (length (psis topic)) 1)) - (is (= (length (item-identifiers topic)) 1)) - (is (string= (uri (first (item-identifiers topic))) - "http://psi.egovpt.org/itemIdentifiers#t50a"))) - ((string= psi "http://psi.egovpt.org/types/links") ;t50 - (is (= (length (in-topicmaps topic)) 1)) - (is (string= (uri (first (item-identifiers (first (in-topicmaps topic))))) - "http://www.isidor.us/unittests/testtm")) - (is-false (names topic)) - (is-false (occurrences topic)) - (is-false (locators topic)) - (is (= (length (psis topic)) 1)) - (is (= (length (item-identifiers topic)) 2)) - (is (or (string= (uri (first (item-identifiers topic))) - "http://psi.egovpt.org/itemIdentifiers#t55") - (string= (uri (second (item-identifiers topic))) - "http://psi.egovpt.org/itemIdentifiers#t55"))) - (is (or (string= (uri (first (item-identifiers topic))) - "http://psi.egovpt.org/itemIdentifiers#t55_1") - (string= (uri (second (item-identifiers topic))) - "http://psi.egovpt.org/itemIdentifiers#t55_1")))) - ((string= psi "http://psi.egovpt.org/standard/Common+Lisp") ;t100 - (is (= (length (in-topicmaps topic)) 1)) - (is (string= (uri (first (item-identifiers (first (in-topicmaps topic))))) - "http://www.isidor.us/unittests/testtm")) - (is (= (length (psis topic)) 1)) - (is (= (length (item-identifiers topic)) 2)) - (is (or (string= (uri (first (item-identifiers topic))) - "http://www.egovpt.org/itemIdentifiers#t100") - (string= (uri (second (item-identifiers topic))) - "http://www.egovpt.org/itemIdentifiers#t100"))) - (is (or (string= (uri (first (item-identifiers topic))) - "http://www.egovpt.org/itemIdentifiers#t100_new") - (string= (uri (second (item-identifiers topic))) - "http://www.egovpt.org/itemIdentifiers#t100_new"))) - (is (= (length (names topic)))) - (let ((name (first (names topic)))) - (is (= (length (item-identifiers name)) 2)) - (is (or (string= (uri (first (item-identifiers name))) - "http://www.egovpt.org/itemIdentifiers#t100_n1") - (string= (uri (second (item-identifiers name))) - "http://www.egovpt.org/itemIdentifiers#t100_n1"))) - (is (or (string= (uri (first (item-identifiers name))) - "http://www.egovpt.org/itemIdentifiers#t100_n1a") - (string= (uri (second (item-identifiers name))) - "http://www.egovpt.org/itemIdentifiers#t100_n1a"))) - (is (string= (charvalue name) - "Common Lisp")) - (is (= (length (variants name)) 2)) - (let ((variant-1 (first (variants name))) - (variant-2 (second (variants name)))) - (is (= (length (item-identifiers variant-1)) 1)) - (is (string= (uri (first (item-identifiers variant-1))) - "http://www.egovpt.org/itemIdentifiers#t100_n_v1")) - (is (= (length (item-identifiers variant-2)) 1)) - (is (string= (uri (first (item-identifiers variant-2))) - "http://www.egovpt.org/itemIdentifiers#t100_n_v2")) - (is (= (length (themes variant-1)) 2)) - (is (or (string= (uri (first (psis (first (themes variant-1))))) - "http://www.topicmaps.org/xtm/1.0/core.xtm#sort") - (string= (uri (first (psis (second (themes variant-1))))) - "http://www.topicmaps.org/xtm/1.0/core.xtm#sort"))) - (is (or (string= (uri (first (psis (first (themes variant-1))))) - "http://psi.egovpt.org/types/long-name") - (string= (uri (first (psis (second (themes variant-1))))) - "http://psi.egovpt.org/types/long-name"))) - (is (= (length (themes variant-2)) 1)) - (is (string= (uri (first (psis (first (themes variant-2))))) - "http://www.topicmaps.org/xtm/1.0/core.xtm#display")) - (is (string= (datatype variant-1) - "http://www.w3.org/2001/XMLSchema#string")) - (is (string= (charvalue variant-1) - "Common-Lisp")) - (is (string= (datatype variant-2) - "http://www.w3.org/2001/XMLSchema#string")) - (is (string= (charvalue variant-2) - "CL")))) - (is (= (length (occurrences topic)) 2)) - (let ((occ-1 (first (occurrences topic))) - (occ-2 (second (occurrences topic)))) - (is (= (length (item-identifiers occ-1)) 1)) - (is (string= (uri (first (item-identifiers occ-1))) - "http://www.egovpt.org/itemIdentifiers#t100_o1")) - (is (= (length (item-identifiers occ-2)) 1)) - (is (string= (uri (first (item-identifiers occ-2))) - "http://www.egovpt.org/itemIdentifiers#t100_o2")) - (is (string= (uri (first (psis (instance-of occ-1)))) - "http://psi.egovpt.org/types/links")) - (is (string= (uri (first (psis (instance-of occ-2)))) - "http://psi.egovpt.org/types/links")) - (is (string= (datatype occ-1) - "http://www.w3.org/2001/XMLSchema#anyURI")) - (is (string= (charvalue occ-1) - "http://www.common-lisp.net/")) - (is (string= (datatype occ-2) - "http://www.w3.org/2001/XMLSchema#anyURI")) - (is (string= (charvalue occ-2) - "http://www.cliki.net/")))) - (t - (if (or (string= psi "http://www.topicmaps.org/xtm/1.0/core.xtm#sort") - (string= psi "http://www.topicmaps.org/xtm/1.0/core.xtm#display")) - (progn - (is (= (length (in-topicmaps topic)) 2)) - (is (or (string= (uri (first (item-identifiers (first (in-topicmaps topic))))) - "http://www.topicmaps.org/xtm/1.0/core.xtm") - (string= (uri (first (item-identifiers (second (in-topicmaps topic))))) - "http://www.topicmaps.org/xtm/1.0/core.xtm"))) - (is (or (string= (uri (first (item-identifiers (first (in-topicmaps topic))))) - "http://www.isidor.us/unittests/testtm") - (string= (uri (first (item-identifiers (second (in-topicmaps topic))))) - "http://www.isidor.us/unittests/testtm")))) - (progn - (is (= (length (in-topicmaps topic)) 1)) - (is (string= (uri (first (item-identifiers (first (in-topicmaps topic))))) - "http://www.topicmaps.org/xtm/1.0/core.xtm"))))))))) - (let ((instanceOf-assoc - (first (elephant:get-instances-by-class 'AssociationC)))) - (is (string= (uri (first (psis (instance-of instanceOf-assoc)))) - constants::*type-instance-psi*)) - (is-false (d:themes instanceOf-assoc)) - (is (string= (d:uri (first (d:item-identifiers (first (d:in-topicmaps instanceOf-assoc))))) - "http://www.isidor.us/unittests/testtm")) - (is-false (d:item-identifiers instanceOf-assoc)) - (let ((super-type-role - (loop for role in (roles instanceOf-assoc) - when (string= (uri (first (psis (instance-of role)))) - constants:*type-psi*) - return role)) - (sub-type-role - (loop for role in (roles instanceOf-assoc) - when (string= (uri (first (psis (instance-of role)))) - constants:*instance-psi*) - return role))) - (is-true (and super-type-role sub-type-role)) - (is (string= (uri (first (psis (player super-type-role)))) - "http://psi.egovpt.org/types/standard")) - (is (string= (uri (first (psis (player sub-type-role)))) - "http://psi.egovpt.org/standard/Common+Lisp")))))))) + (json-importer:json-to-elem *t64*) + (json-importer:json-to-elem *t100-3*) + (let ((assoc-7 + (identified-construct + (elephant:get-instance-by-value 'ItemidentifierC 'uri + "http://psi.egovpt.org/itemIdentifiers#assoc_7")))) + (is (= (length (item-identifiers assoc-7)))) + (is (string= (uri (first (item-identifiers assoc-7))) + "http://psi.egovpt.org/itemIdentifiers#assoc_7")) + (is (= (length (roles assoc-7)) 2)) + (is (string= (uri (first (psis (instance-of assoc-7)))) + "http://psi.egovpt.org/types/serviceUsesStandard")) + (let ((role-1 (first (roles assoc-7))) + (role-2 (second (roles assoc-7)))) + (is (string= (uri (first (psis (instance-of role-1)))) + "http://psi.egovpt.org/types/ServiceRoleType")) + (is (or (string= (uri (first (psis (player role-1)))) + "http://psi.egovpt.org/service/Google+Maps") + (string= (uri (first (psis (player role-1)))) + "http://maps.google.com"))) + (is (string= (uri (first (psis (instance-of role-2)))) + "http://psi.egovpt.org/types/StandardRoleType")) + (is (string= (uri (first (psis (player role-2)))) + "http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metada…"))))))) + + +(test test-json-importer-merge-1 + (let + ((dir "data_base")) + (with-fixture initialize-destination-db (dir) + (elephant:open-store (xml-importer:get-store-spec dir)) + (xml-importer:init-isidorus) + (elephant:open-store (xml-importer:get-store-spec dir)) ; init-isidorus closes the store + (is (= (length (elephant:get-instances-by-class 'TopicC)) 13)) + (is (= (length (elephant:get-instances-by-class 'AssociationC)) 0)) + (is (= (length (elephant:get-instances-by-class 'TopicMapC)) 1)) + (json-importer:json-to-elem *t100-1*) + (is (= (length (elephant:get-instances-by-class 'TopicC)) 17)) + (is (= (length (elephant:get-instances-by-class 'AssociationC)) 1)) + (is (= (length (elephant:get-instances-by-class 'TopicMapC)) 2)) + (let ((core-tm + (loop for tm in (elephant:get-instances-by-class 'TopicMapC) + when (string= (uri (first (item-identifiers tm))) + "http://www.topicmaps.org/xtm/1.0/core.xtm") + return tm)) + (test-tm + (loop for tm in (elephant:get-instances-by-class 'TopicMapC) + when (string= (uri (first (item-identifiers tm))) + "http://www.isidor.us/unittests/testtm") + return tm))) + (is-true (and core-tm test-tm))) + (json-importer:json-to-elem *t100-2*) + (is (= (length (elephant:get-instances-by-class 'TopicC)) 17)) + (is (= (length (elephant:get-instances-by-class 'AssociationC)) 1)) + (is (= (length (elephant:get-instances-by-class 'TopicMapC)) 2)) + (let ((core-tm + (loop for tm in (elephant:get-instances-by-class 'TopicMapC) + when (string= (uri (first (item-identifiers tm))) + "http://www.topicmaps.org/xtm/1.0/core.xtm") + return tm)) + (test-tm + (loop for tm in (elephant:get-instances-by-class 'TopicMapC) + when (string= (uri (first (item-identifiers tm))) + "http://www.isidor.us/unittests/testtm") + return tm))) + (is-true (and core-tm test-tm))) + (let ((topics (elephant:get-instances-by-class 'TopicC))) + (loop for topic in topics + do (let ((psi (uri (first (psis topic))))) + (cond + ((string= psi "http://psi.egovpt.org/types/standard") ;t3 + (is (= (length (in-topicmaps topic)) 1)) + (is (string= (uri (first (item-identifiers (first (in-topicmaps topic))))) + "http://www.isidor.us/unittests/testtm")) + (is-false (names topic)) + (is-false (occurrences topic)) + (is-false (locators topic)) + (is (= (length (psis topic)) 1)) + (is (= (length (item-identifiers topic)) 2)) + (is (or (string= (uri (first (item-identifiers topic))) + "http://www.egovpt.org/itemIdentifiers#t3") + (string= (uri (second (item-identifiers topic))) + "http://www.egovpt.org/itemIdentifiers#t3"))) + (is (or (string= (uri (first (item-identifiers topic))) + "http://psi.egovpt.org/itemIdentifiers#t3") + (string= (uri (second (item-identifiers topic))) + "http://psi.egovpt.org/itemIdentifiers#t3")))) + ((string= psi "http://psi.egovpt.org/types/long-name") ;t50a + (is (= (length (in-topicmaps topic)) 1)) + (is (string= (uri (first (item-identifiers (first (in-topicmaps topic))))) + "http://www.isidor.us/unittests/testtm")) + (is-false (names topic)) + (is-false (occurrences topic)) + (is-false (locators topic)) + (is (= (length (psis topic)) 1)) + (is (= (length (item-identifiers topic)) 1)) + (is (string= (uri (first (item-identifiers topic))) + "http://psi.egovpt.org/itemIdentifiers#t50a"))) + ((string= psi "http://psi.egovpt.org/types/links") ;t50 + (is (= (length (in-topicmaps topic)) 1)) + (is (string= (uri (first (item-identifiers (first (in-topicmaps topic))))) + "http://www.isidor.us/unittests/testtm")) + (is-false (names topic)) + (is-false (occurrences topic)) + (is-false (locators topic)) + (is (= (length (psis topic)) 1)) + (is (= (length (item-identifiers topic)) 2)) + (is (or (string= (uri (first (item-identifiers topic))) + "http://psi.egovpt.org/itemIdentifiers#t55") + (string= (uri (second (item-identifiers topic))) + "http://psi.egovpt.org/itemIdentifiers#t55"))) + (is (or (string= (uri (first (item-identifiers topic))) + "http://psi.egovpt.org/itemIdentifiers#t55_1") + (string= (uri (second (item-identifiers topic))) + "http://psi.egovpt.org/itemIdentifiers#t55_1"))))))))))) + + +(test test-json-importer-merge-2 + (let + ((dir "data_base")) + (with-fixture initialize-destination-db (dir) + (elephant:open-store (xml-importer:get-store-spec dir)) + (xml-importer:init-isidorus) + (elephant:open-store (xml-importer:get-store-spec dir)) ; init-isidorus closes the store + (json-importer:json-to-elem *t100-1*) + (let ((core-tm + (loop for tm in (elephant:get-instances-by-class 'TopicMapC) + when (string= (uri (first (item-identifiers tm))) + "http://www.topicmaps.org/xtm/1.0/core.xtm") + return tm)) + (test-tm + (loop for tm in (elephant:get-instances-by-class 'TopicMapC) + when (string= (uri (first (item-identifiers tm))) + "http://www.isidor.us/unittests/testtm") + return tm))) + (is-true (and core-tm test-tm))) + (json-importer:json-to-elem *t100-2*) + (let ((topics (elephant:get-instances-by-class 'TopicC))) + (loop for topic in topics + do (let ((psi (uri (first (psis topic))))) + (cond + ((string= psi "http://psi.egovpt.org/types/standard") t) ;was already checked + ((string= psi "http://psi.egovpt.org/types/long-name") t) ;was already checked + ((string= psi "http://psi.egovpt.org/types/links") t) ;was already checked + ((string= psi "http://psi.egovpt.org/standard/Common+Lisp") ;t100 + (is (= (length (in-topicmaps topic)) 1)) + (is (string= (uri (first (item-identifiers (first (in-topicmaps topic))))) + "http://www.isidor.us/unittests/testtm")) + (is (= (length (psis topic)) 1)) + (is (= (length (item-identifiers topic)) 2)) + (is (or (string= (uri (first (item-identifiers topic))) + "http://www.egovpt.org/itemIdentifiers#t100") + (string= (uri (second (item-identifiers topic))) + "http://www.egovpt.org/itemIdentifiers#t100"))) + (is (or (string= (uri (first (item-identifiers topic))) + "http://www.egovpt.org/itemIdentifiers#t100_new") + (string= (uri (second (item-identifiers topic))) + "http://www.egovpt.org/itemIdentifiers#t100_new"))) + (is (= (length (names topic)))) + (let ((name (first (names topic)))) + (is (= (length (item-identifiers name)) 2)) + (is (or (string= (uri (first (item-identifiers name))) + "http://www.egovpt.org/itemIdentifiers#t100_n1") + (string= (uri (second (item-identifiers name))) + "http://www.egovpt.org/itemIdentifiers#t100_n1"))) + (is (or (string= (uri (first (item-identifiers name))) + "http://www.egovpt.org/itemIdentifiers#t100_n1a") + (string= (uri (second (item-identifiers name))) + "http://www.egovpt.org/itemIdentifiers#t100_n1a"))) + (is (string= (charvalue name) + "Common Lisp")) + (is (= (length (variants name)) 2)) + (let ((variant-1 (first (variants name))) + (variant-2 (second (variants name)))) + (is (= (length (item-identifiers variant-1)) 1)) + (is (string= (uri (first (item-identifiers variant-1))) + "http://www.egovpt.org/itemIdentifiers#t100_n_v1")) + (is (= (length (item-identifiers variant-2)) 1)) + (is (string= (uri (first (item-identifiers variant-2))) + "http://www.egovpt.org/itemIdentifiers#t100_n_v2")) + (is (= (length (themes variant-1)) 2)) + (is (or (string= (uri (first (psis (first (themes variant-1))))) + "http://www.topicmaps.org/xtm/1.0/core.xtm#sort") + (string= (uri (first (psis (second (themes variant-1))))) + "http://www.topicmaps.org/xtm/1.0/core.xtm#sort"))) + (is (or (string= (uri (first (psis (first (themes variant-1))))) + "http://psi.egovpt.org/types/long-name") + (string= (uri (first (psis (second (themes variant-1))))) + "http://psi.egovpt.org/types/long-name"))) + (is (= (length (themes variant-2)) 1)) + (is (string= (uri (first (psis (first (themes variant-2))))) + "http://www.topicmaps.org/xtm/1.0/core.xtm#display")) + (is (string= (datatype variant-1) + "http://www.w3.org/2001/XMLSchema#string")) + (is (string= (charvalue variant-1) + "Common-Lisp")) + (is (string= (datatype variant-2) + "http://www.w3.org/2001/XMLSchema#string")) + (is (string= (charvalue variant-2) + "CL")))) + (is (= (length (occurrences topic)) 2)) + (let ((occ-1 (first (occurrences topic))) + (occ-2 (second (occurrences topic)))) + (is (= (length (item-identifiers occ-1)) 1)) + (is (string= (uri (first (item-identifiers occ-1))) + "http://www.egovpt.org/itemIdentifiers#t100_o1")) + (is (= (length (item-identifiers occ-2)) 1)) + (is (string= (uri (first (item-identifiers occ-2))) + "http://www.egovpt.org/itemIdentifiers#t100_o2")) + (is (string= (uri (first (psis (instance-of occ-1)))) + "http://psi.egovpt.org/types/links")) + (is (string= (uri (first (psis (instance-of occ-2)))) + "http://psi.egovpt.org/types/links")) + (is (string= (datatype occ-1) + "http://www.w3.org/2001/XMLSchema#anyURI")) + (is (string= (charvalue occ-1) + "http://www.common-lisp.net/")) + (is (string= (datatype occ-2) + "http://www.w3.org/2001/XMLSchema#anyURI")) + (is (string= (charvalue occ-2) + "http://www.cliki.net/")))) + (t + (if (or (string= psi "http://www.topicmaps.org/xtm/1.0/core.xtm#sort") + (string= psi "http://www.topicmaps.org/xtm/1.0/core.xtm#display")) + (progn + (is (= (length (in-topicmaps topic)) 2)) + (is (or (string= (uri (first (item-identifiers (first (in-topicmaps topic))))) + "http://www.topicmaps.org/xtm/1.0/core.xtm") + (string= (uri (first (item-identifiers (second (in-topicmaps topic))))) + "http://www.topicmaps.org/xtm/1.0/core.xtm"))) + (is (or (string= (uri (first (item-identifiers (first (in-topicmaps topic))))) + "http://www.isidor.us/unittests/testtm") + (string= (uri (first (item-identifiers (second (in-topicmaps topic))))) + "http://www.isidor.us/unittests/testtm")))) + (progn + (is (= (length (in-topicmaps topic)) 1)) + (is (string= (uri (first (item-identifiers (first (in-topicmaps topic))))) + "http://www.topicmaps.org/xtm/1.0/core.xtm")))))))))))) + + +(test test-json-importer-merge-3 + (let + ((dir "data_base")) + (with-fixture initialize-destination-db (dir) + (elephant:open-store (xml-importer:get-store-spec dir)) + (xml-importer:init-isidorus) + (elephant:open-store (xml-importer:get-store-spec dir)) ; init-isidorus closes the store + (json-importer:json-to-elem *t100-1*) + (let ((core-tm + (loop for tm in (elephant:get-instances-by-class 'TopicMapC) + when (string= (uri (first (item-identifiers tm))) + "http://www.topicmaps.org/xtm/1.0/core.xtm") + return tm)) + (test-tm + (loop for tm in (elephant:get-instances-by-class 'TopicMapC) + when (string= (uri (first (item-identifiers tm))) + "http://www.isidor.us/unittests/testtm") + return tm))) + (is-true (and core-tm test-tm))) + (json-importer:json-to-elem *t100-2*) + (let ((instanceOf-assoc + (first (elephant:get-instances-by-class 'AssociationC)))) + (is (string= (uri (first (psis (instance-of instanceOf-assoc)))) + constants::*type-instance-psi*)) + (is-false (d:themes instanceOf-assoc)) + (is (string= (d:uri (first (d:item-identifiers (first (d:in-topicmaps instanceOf-assoc))))) + "http://www.isidor.us/unittests/testtm")) + (is-false (d:item-identifiers instanceOf-assoc)) + (let ((super-type-role + (loop for role in (roles instanceOf-assoc) + when (string= (uri (first (psis (instance-of role)))) + constants:*type-psi*) + return role)) + (sub-type-role + (loop for role in (roles instanceOf-assoc) + when (string= (uri (first (psis (instance-of role)))) + constants:*instance-psi*) + return role))) + (is-true (and super-type-role sub-type-role)) + (is (string= (uri (first (psis (player super-type-role)))) + "http://psi.egovpt.org/types/standard")) + (is (string= (uri (first (psis (player sub-type-role)))) + "http://psi.egovpt.org/standard/Common+Lisp"))))))) (test test-get-all-topic-psis @@ -1054,10 +1264,22 @@ (defun run-json-tests() (tear-down-test-db) - ;(run! 'json-tests)) - (it.bese.fiveam:run! 'test-get-fragment-values-from-json-list) - ;(it.bese.fiveam:run! 'test-json-importer) ;currently this unittest causes some problems - (it.bese.fiveam:run! 'test-json-importer-merge) + (it.bese.fiveam:run! 'test-get-fragment-values-from-json-list-general) + (it.bese.fiveam:run! 'test-get-fragment-values-from-json-list-names) + (it.bese.fiveam:run! 'test-get-fragment-values-from-json-list-occurrences) + (it.bese.fiveam:run! 'test-get-fragment-values-from-json-list-topicStubs) + (it.bese.fiveam:run! 'test-get-fragment-values-from-json-list-associations) + (it.bese.fiveam:run! 'test-json-importer-general-1) + (it.bese.fiveam:run! 'test-json-importer-general-2) + (it.bese.fiveam:run! 'test-json-importer-general-3) + (it.bese.fiveam:run! 'test-json-importer-topics-1) + (it.bese.fiveam:run! 'test-json-importer-topics-2) + (it.bese.fiveam:run! 'test-json-importer-topics-3) + (it.bese.fiveam:run! 'test-json-importer-topics-4) + (it.bese.fiveam:run! 'test-json-importer-associations) + (it.bese.fiveam:run! 'test-json-importer-merge-1) + (it.bese.fiveam:run! 'test-json-importer-merge-2) + (it.bese.fiveam:run! 'test-json-importer-merge-3) (it.bese.fiveam:run! 'test-to-json-string-associations) (it.bese.fiveam:run! 'test-to-json-string-fragments) (it.bese.fiveam:run! 'test-to-json-string-topics)

1 0

[isidorus-cvs] r123 - trunk/src/unit_tests
by Lukas Giessmann 27 Aug '09

27 Aug '09

Author: lgiessmann Date: Thu Aug 27 06:49:28 2009 New Revision: 123 Log: Added: trunk/src/unit_tests/rdf_exporter_test.lisp Added: trunk/src/unit_tests/rdf_exporter_test.lisp ============================================================================== --- (empty file) +++ trunk/src/unit_tests/rdf_exporter_test.lisp Thu Aug 27 06:49:28 2009 @@ -0,0 +1,883 @@ +;;+----------------------------------------------------------------------------- +;;+ Isidorus +;;+ (c) 2008-2009 Marc Kuester, Christoph Ludwig, Lukas Giessmann +;;+ +;;+ Isidorus is freely distributable under the LGPL license. +;;+ You can find a detailed description in trunk/docs/LGPL-LICENSE.txt. +;;+----------------------------------------------------------------------------- + + +(defpackage :rdf-exporter-test + (:use + :common-lisp + :xml-importer + :datamodel + :it.bese.FiveAM + :fixtures) + (:import-from :constants + *rdf-ns* + *rdfs-ns* + *rdf2tm-ns* + *tm2rdf-ns* + *xml-ns* + *xml-string* + *xml-uri*) + (:import-from :xml-tools + xpath-child-elems-by-qname + xpath-single-child-elem-by-qname + xpath-select-location-path + get-ns-attribute) + (:export :run-rdf-exporter-tests + :test-resources + :test-goethe + :test-erlkoenig + :test-prometheus + :test-zauberlehrling + :test-frankfurt + :test-weimar + :test-berlin + :test-region + :test-city-and-metropolis + :test-germany + :test-german + :test-born-event + :test-died-event + :test-dateRange-zauberlehrling + :test-dateRange-erlkoenig + :test-dateRange-prometheus + :test-schiller + :test-single-nodes + :test-collection + :test-association)) + +(declaim (optimize (debug 3) (speed 0) (safety 3) (space 0) (compilation-speed 0))) + +(in-package :rdf-exporter-test) + + +(def-suite rdf-exporter-test + :description "tests various key functions of the exporter") + +(in-suite rdf-exporter-test) + + +(defvar *sw-arc* "http://some.where/relationship/") +(defvar *xml-ulong* "http://www.w3.org/2001/XMLSchema#unsignedLong") +(defvar *xml-date* "http://www.w3.org/2001/XMLSchema#date") + + +(defun get-dom-root () + "Returns the document's root node." + (let ((dom (cxml:parse-file "./__out__.rdf" (cxml-dom:make-dom-builder)))) + (when dom + (let ((child-nodes (dom:child-nodes dom))) + (when (> (length child-nodes) 0) + (elt child-nodes 0)))))) + + +(defun identifier-p (owner-elem value &key (what "itemIdentity")) + "Returns t if the owner element owns a property correponding to the + attribute what and the value." + (literal-p owner-elem *tm2rdf-ns* what value :datatype *xml-uri*)) + + +(defun role-p (owner-elem roletype-uri item-identifiers + &key (player-uri nil) (player-id nil)) + "Returns t if the owner-element has a node that corresponds to a + role with the given parameters." + (loop for item across (dom:child-nodes owner-elem) + when (let ((node-ns (dom:namespace-uri item)) + (node-name (rdf-importer::get-node-name item))) + (and (= (length (dom:child-nodes item)) + (+ 3 (length item-identifiers))) + (string= node-ns *tm2rdf-ns*) + (string= node-name "role") + (type-p item (concatenate 'string *tm2rdf-ns* "Role")) + (if player-uri + (property-p item *tm2rdf-ns* "player" + :resource player-uri) + (property-p item *tm2rdf-ns* "player" + :nodeID player-id)) + (property-p item *tm2rdf-ns* "roletype" + :resource roletype-uri) + (= (length item-identifiers) + (length (loop for ii in item-identifiers + when (identifier-p item ii) + collect ii))))) + return t)) + + +(defun get-resources-by-uri (uri) + "Returns a list of resource elements that owns the attribute + about with the value of uri." + (let ((root (get-dom-root))) + (let ((resources (xpath-child-elems-by-qname root *rdf-ns* "Description"))) + (loop for item across resources + when (string= (get-ns-attribute item "about") uri) + collect item)))) + + +(defun get-resources-by-id (id) + "Returns a list of resource elements that owns the attribute + nodeID with the value of id." + (let ((root (get-dom-root))) + (let ((resources (xpath-child-elems-by-qname root *rdf-ns* "Description"))) + (loop for item across resources + when (string= (get-ns-attribute item "nodeID") id) + collect item)))) + + +(defun type-p (owner-elem type-uri) + "Returns t if the given uri is contained in a property + within the owner-elem." + (loop for item across (dom:child-nodes owner-elem) + when (let ((node-ns (dom:namespace-uri item)) + (node-name (rdf-importer::get-node-name item)) + (resource (rdf-importer::get-ns-attribute + item "resource"))) + (and (string= node-ns *rdf-ns*) + (string= node-name "type") + (string= resource type-uri))) + return t)) + + +(defun literal-p (owner-elem arc-uri arc-name literal-value + &key (datatype *xml-string*) + (xml-lang nil)) + "Returns t if the owner-elem contains an arc with the uri + arc-uri, the arc-name and the literal content literal-value." + (loop for item across (dom:child-nodes owner-elem) + when (let ((node-ns (dom:namespace-uri item)) + (node-name (rdf-importer::get-node-name item)) + (value (rdf-importer::child-nodes-or-text item :trim nil)) + (fn-datatype (rdf-importer::get-ns-attribute item "datatype")) + (fn-xml-lang (rdf-importer::get-ns-attribute + item "lang" :ns-uri *xml-ns*))) + (and (string= node-ns arc-uri) + (string= node-name arc-name) + (and (stringp literal-value) + (string= value literal-value)) + (string= datatype (if fn-datatype + fn-datatype + "")) + (or (not (or xml-lang fn-xml-lang)) + (and (and xml-lang fn-xml-lang) + (string= xml-lang fn-xml-lang))))) + return t)) + + +(defun property-p (owner-elem arc-uri arc-name + &key (resource "") (nodeID "")) + "Returns t if the owner element owns a property with the + given characteristics." + (if (and (string= resource "") (string= nodeID "")) + nil + (loop for item across (dom:child-nodes owner-elem) + when (let ((node-ns (dom:namespace-uri item)) + (node-name (rdf-importer::get-node-name item)) + (fn-resource (unless (dom:text-node-p item) + (rdf-importer::get-ns-attribute item + "resource"))) + (fn-nodeID (rdf-importer::get-ns-attribute item "nodeID"))) + (and (string= node-ns arc-uri) + (string= node-name arc-name) + (or (and fn-resource + (string= fn-resource resource)) + (and fn-nodeID + (string= fn-nodeID nodeID))))) + return t))) + + +(defun variant-p (owner-elem variant-scopes item-identifiers variant-value + &key (datatype *xml-string*)) + "Returns t if the owner contains a variant element with the passed + characteristics." + (loop for item across (dom:child-nodes owner-elem) + when (let ((node-ns (dom:namespace-uri item)) + (node-name (rdf-importer::get-node-name item))) + (and (= (+ (length variant-scopes) + (length item-identifiers) + 2) + (length (dom:child-nodes owner-elem))) + (string= node-ns *tm2rdf-ns*) + (string= node-name "variant") + (literal-p item *tm2rdf-ns* "value" variant-value + :datatype datatype) + (= (length variant-scopes) + (length (loop for scope in variant-scopes + when (property-p item *tm2rdf-ns* "scope" + :resource scope) + collect scope))) + (= (length item-identifiers) + (length (loop for ii in item-identifiers + when (identifier-p item ii) + collect ii))) + (type-p item (concatenate 'string *tm2rdf-ns* "Variant")))) + return t)) + + +(defun name-p (owner-elem name-type name-scopes item-identifiers name-value + &key (variants nil)) + "Returns t if the parent node owns a name with the given characterics." + (loop for item across (dom:child-nodes owner-elem) + when (let ((node-ns (dom:namespace-uri item)) + (node-name (rdf-importer::get-node-name item))) + (and (= (length (dom:child-nodes item)) + (+ 3 (length name-scopes) + (length item-identifiers) + (length variants))) + (string= node-ns *tm2rdf-ns*) + (string= node-name "name") + (type-p item (concatenate 'string *tm2rdf-ns* + "Name")) + (property-p item *tm2rdf-ns* "nametype" :resource name-type) + (= (length name-scopes) + (length (loop for scope in name-scopes + when (property-p item *tm2rdf-ns* "scope" + :resource scope) + collect scope))) + (= (length item-identifiers) + (length (loop for ii in item-identifiers + when (identifier-p item ii) + collect ii))) + (= (length variants) + (length (loop for variant in variants + when (variant-p + item (getf variant :scopes) + (getf variant :item-identifiers) + (getf variant :value) + :datatype (getf variant :datatype)) + collect variant))) + (literal-p item *tm2rdf-ns* "value" name-value))) + return t)) + + +(defun occurrence-p (owner-elem occurrence-type occurrence-scopes + item-identifiers occurrence-value + &key (datatype *xml-string*)) + "Returns t if the parent node owns an occurrence with the given characterics." + (loop for item across (dom:child-nodes owner-elem) + when (let ((node-ns (dom:namespace-uri item)) + (node-name (rdf-importer::get-node-name item))) + (and (= (length (dom:child-nodes item)) + (+ 3 (length occurrence-scopes) + (length item-identifiers))) + (string= node-ns *tm2rdf-ns*) + (string= node-name "occurrence") + (type-p item (concatenate 'string *tm2rdf-ns* + "Occurrence")) + (property-p item *tm2rdf-ns* "occurrencetype" + :resource occurrence-type) + (= (length occurrence-scopes) + (length (loop for scope in occurrence-scopes + when (property-p item *tm2rdf-ns* "scope" + :resource scope) + collect scope))) + (= (length item-identifiers) + (length (loop for ii in item-identifiers + when (identifier-p item ii) + collect ii))) + (literal-p item *tm2rdf-ns* "value" occurrence-value + :datatype datatype))) + return t)) + + +(test test-resources + "Tests the general amount of resources." + (with-fixture rdf-exporter-test-db () + (let ((root (get-dom-root))) + (is-true root) + (let ((resources (xpath-child-elems-by-qname root *rdf-ns* "Description"))) + (is (= (length resources) 29)) + (is (= (length (loop for item across resources + when (get-ns-attribute item "about") + collect item)) + 19)) + (is (= (length (loop for item across resources + when (get-ns-attribute item "nodeID") + collect item)) + 10)))))) + + +(test test-goethe + "Tests the resource goethe." + (with-fixture rdf-exporter-test-db () + (let ((goethes (get-resources-by-uri "http://some.where/author/Goethe"))) + (is (= (length goethes) 1)) + (let ((me (find-if #'(lambda(x) + (= (length (dom:child-nodes x)) 7)) + goethes))) + (is-true me) + (is (type-p me "http://isidorus/tm2rdf_mapping/Topic")) + (is (type-p me "http://some.where/types/Author")) + (is (literal-p me *sw-arc* "lastName" + "von Goethe")) + (is (name-p me "http://some.where/relationship/firstName" nil + (list "http://some.where/name_ii_1") "Johann Wolfgang")) + (let ((born-id (concatenate + 'string "id_" + (write-to-string + (elephant::oid + (d:topic + (elephant:get-instance-by-value + 'd:OccurrenceC 'd:charvalue "28.08.1749")))))) + (died-id (concatenate + 'string "id_" + (write-to-string + (elephant::oid + (d:topic + (elephant:get-instance-by-value + 'd:OccurrenceC 'd:charvalue "22.03.1832"))))))) + (is-true (property-p me *sw-arc* "born" :nodeID born-id)) + (is-true (property-p me *sw-arc* "died" :nodeID died-id))) + (is-true (loop for item across (dom:child-nodes me) + when (let ((node-ns (dom:namespace-uri item)) + (node-name (rdf-importer::get-node-name item)) + (nodeID (rdf-importer::get-ns-attribute + item "nodeID"))) + (and (string= node-ns *sw-arc*) + (string= node-name "wrote") + nodeID)) + return t)))))) + + +(test test-erlkoenig + "Tests the resource erlkoenig." + (with-fixture rdf-exporter-test-db () + (let ((erlkoenigs (get-resources-by-uri + "http://some.where/ballad/Der_Erlkoenig"))) + (is (= (length erlkoenigs) 1)) + (let ((me (find-if #'(lambda(x) + (= (length (dom:child-nodes x)) 5)) + erlkoenigs))) + (is-true me) + (is-true (type-p me "http://some.where/types/Ballad")) + (is-true (type-p me (concatenate 'string *tm2rdf-ns* "Topic"))) + (is-true (literal-p me *sw-arc* "content" + "Wer reitet so spät durch Nacht und Wind? ..." + :xml-lang "de")) + (is-true (occurrence-p me "http://some.where/relationship/title" + (list "http://some.where/scope/en") nil + "Der Erlkönig")) + (let ((dateRange-id + (concatenate + 'string "id_" + (write-to-string + (elephant::oid + (d:topic + (elephant:get-instance-by-value + 'd:OccurrenceC 'd:charvalue "31.12.1782"))))))) + (is-true (property-p me *sw-arc* "dateRange" + :nodeID dateRange-id))))))) + + +(test test-prometheus + "Tests the resoruce prometheus." + (with-fixture rdf-exporter-test-db () + (let ((prometheus (get-resources-by-uri + "http://some.where/poem/Prometheus"))) + (is (= (length prometheus) 1)) + (let ((me (find-if #'(lambda(x) + (= (length (dom:child-nodes x)) 4)) + prometheus))) + (is-true me) + (is-true (type-p me "http://some.where/types/Poem")) + (is-true (literal-p me *sw-arc* "title" + "Prometheus" :xml-lang "de")) + (is-true (literal-p me *sw-arc* "content" + "Bedecke deinen Himmel, Zeus, ..." + :xml-lang "de")) + (let ((dateRange-id + (concatenate + 'string "id_" + (write-to-string + (elephant::oid + (d:topic + (elephant:get-instance-by-value + 'd:OccurrenceC 'd:charvalue "01.01.1772"))))))) + (is-true (property-p me *sw-arc* "dateRange" + :nodeID dateRange-id))))))) + + +(test test-zauberlehrling + "Tests the resoruce zauberlehrling." + (with-fixture rdf-exporter-test-db () + (let ((zauberlehrlings (get-resources-by-uri + "http://some.where/poem/Der_Zauberlehrling"))) + (is (= (length zauberlehrlings) )) + (let ((me (find-if #'(lambda(x) + (= (length (dom:child-nodes x)) 10)) + zauberlehrlings))) + (is-true me) + (is-true (type-p me "http://some.where/types/Poem")) + (is-true (type-p me (concatenate 'string *tm2rdf-ns* "Topic"))) + (is-true (identifier-p me "http://some.where/poem/Zauberlehrling" + :what "subjectIdentifier")) + (is-true (identifier-p + me "http://some.where/poem/Zauberlehrling_itemIdentity_1")) + (is-true (identifier-p + me "http://some.where/poem/Zauberlehrling_itemIdentity_2")) + (is-true (identifier-p me "http://some.where/resource_1" + :what "subjectLocator")) + (is-true (identifier-p me "http://some.where/resource_2" + :what "subjectLocator")) + (is-true (literal-p me "http://some.where/relationship/" "content" + "Hat der alte Hexenmeister ...")) + (is-true (occurrence-p me "http://some.where/relationship/title" + (list "http://some.where/scope/en" + "http://isidorus/rdf2tm_mapping/scope/de") + (list "http://some.where/occurrence_ii_1" + "http://some.where/occurrence_ii_2") + "Der Zauberlehrling")) + (let ((dateRange-id + (concatenate + 'string "id_" + (write-to-string + (elephant::oid + (d:topic + (elephant:get-instance-by-value + 'd:OccurrenceC 'd:charvalue "01.01.1797"))))))) + (is-true (property-p me *sw-arc* "dateRange" + :nodeID dateRange-id))))))) + + +(test test-frankfurt + "Tests the resoruce frankfurt." + (with-fixture rdf-exporter-test-db () + (let ((frankfurts (get-resources-by-uri + "http://some.where/metropolis/FrankfurtMain"))) + (is (= (length frankfurts) 1)) + (let ((me (find-if #'(lambda(x) + (= (length (dom:child-nodes x)) 4)) + frankfurts))) + (is-true me) + (is-true (type-p me "http://some.where/types/Metropolis")) + (is-true (literal-p me *sw-arc* "fullName" "Frankfurt am Main")) + (is-true (literal-p me *sw-arc* "population" "659000" + :datatype *xml-ulong*)) + (is-true (property-p me *sw-arc* "locatedIn" + :resource "http://some.where/country/Germany")))))) + +(test test-weimar + "Tests the resoruce weimar." + (with-fixture rdf-exporter-test-db () + (let ((weimars (get-resources-by-uri + "http://some.where/city/Weimar"))) + (is (= (length weimars) 1)) + (let ((me (find-if #'(lambda(x) + (= (length (dom:child-nodes x)) 4)) + weimars))) + (is-true me) + (is-true (type-p me "http://some.where/types/City")) + (is-true (literal-p me *sw-arc* "fullName" "Weimar")) + (is-true (literal-p me *sw-arc* "population" "64720" + :datatype *xml-ulong*)) + (is-true (property-p me *sw-arc* "locatedIn" + :resource "http://some.where/country/Germany")))))) + + +(test test-berlin + "Tests the resource berlin." + (with-fixture rdf-exporter-test-db () + (let ((berlins (get-resources-by-uri + "http://some.where/metropolis/Berlin"))) + (is (= (length berlins) 1)) + (let ((me (find-if #'(lambda(x) + (= (length (dom:child-nodes x)) 4)) + berlins))) + (is-true me) + (is-true (type-p me "http://some.where/types/Metropolis")) + (is-true (literal-p me *sw-arc* "fullName" "Berlin")) + (is-true (literal-p me *sw-arc* "population" "3431473" + :datatype *xml-ulong*)) + (is-true (property-p me *sw-arc* "locatedIn" + :resource "http://some.where/country/Germany")))))) + + +(test test-region + "Tests the resource region." + (with-fixture rdf-exporter-test-db () + (let ((regions (get-resources-by-uri + "http://some.where/types/Region")) + (citys (get-resources-by-uri + "http://some.where/types/City")) + (metropolis (get-resources-by-uri + "http://some.where/types/Metropolis"))) + (is (= (length regions) 1)) + (is (= (length (dom:child-nodes (elt regions 0))) 0)) + (is (= (length citys) 1)) + (is (= (length (dom:child-nodes (elt citys 0))) 1)) + (is-true (property-p (elt citys 0) *rdfs-ns* "subClassOf" + :resource "http://some.where/types/Region")) + (is (= (length metropolis) 1)) + (is (= (length (dom:child-nodes (elt metropolis 0))) 1)) + (is-true (property-p (elt metropolis 0) *rdfs-ns* "subClassOf" + :resource "http://some.where/types/Region"))))) + + +(test test-city-and-metropolis + "Tests the resource city and metropolis." + (with-fixture rdf-exporter-test-db () + (let ((citys (get-resources-by-uri + "http://some.where/types/City"))) + (is (= (length citys) 1)) + (is (= (length (dom:child-nodes (elt citys 0))) 1)) + (is-true (property-p (elt citys 0) *rdfs-ns* "subClassOf" + :resource "http://some.where/types/Region"))) + (let ((metropolis (get-resources-by-uri + "http://some.where/types/Metropolis"))) + (is (= (length metropolis) 1)) + (is (= (length (dom:child-nodes (elt metropolis 0))) 1)) + (is-true (property-p (elt metropolis 0) *rdfs-ns* "subClassOf" + :resource "http://some.where/types/Region"))))) + + +(test test-germany + "Tests the resource germany." + (with-fixture rdf-exporter-test-db () + (let ((germanys (get-resources-by-uri + "http://some.where/country/Germany"))) + (is (= (length germanys) 1)) + (let ((me (find-if #'(lambda(x) + (= (length (dom:child-nodes x)) 5)) + germanys))) + (is-true me) + (is-true (type-p me "http://some.where/types/Country")) + (is-true (literal-p me *sw-arc* "nativeName" "Deutschland" + :xml-lang "de")) + (is-true (literal-p me *sw-arc* "population" "82099232" + :datatype *xml-ulong*)) + (is-true (property-p me *sw-arc* "capital" + :resource "http://some.where/metropolis/Berlin")) + (is-true (property-p me *sw-arc* "officialese" + :resource "http://some.where/language/German")))))) + + +(test test-german + "Tests the resource german." + (with-fixture rdf-exporter-test-db () + (let ((germans (get-resources-by-uri + "http://some.where/language/German"))) + (is (= (length germans) 1)) + (is-true (type-p (elt germans 0) "http://some.where/types/Language"))))) + + +(test test-born-event + "Tests the blank node of the born-event." + (with-fixture rdf-exporter-test-db () + (let ((born-id (concatenate + 'string "id_" + (write-to-string + (elephant::oid + (d:topic + (elephant:get-instance-by-value 'd:OccurrenceC + 'd:charvalue + "28.08.1749"))))))) + (is-true born-id) + (let ((born-events (get-resources-by-id born-id))) + (is (= (length born-events) 1)) + (let ((me (find-if #'(lambda(x) + (= (length (dom:child-nodes x)) 3)) + born-events))) + (is-true me) + (is-true (literal-p me *sw-arc* "date" "28.08.1749" + :datatype *xml-date*)) + (is-true (type-p me "http://some.where/types/Event")) + (is-true + (property-p me *sw-arc* "place" + :resource + "http://some.where/metropolis/FrankfurtMain"))))))) + + +(test test-died-event + "Tests the blank node of the born-event." + (with-fixture rdf-exporter-test-db () + (let ((born-id (concatenate + 'string "id_" + (write-to-string + (elephant::oid + (d:topic + (elephant:get-instance-by-value 'd:OccurrenceC + 'd:charvalue + "22.03.1832"))))))) + (is-true born-id) + (let ((born-events (get-resources-by-id born-id))) + (is (= (length born-events) 1)) + (let ((me (find-if #'(lambda(x) + (= (length (dom:child-nodes x)) 3)) + born-events))) + (is-true me) + (is-true (literal-p me *sw-arc* "date" "22.03.1832" + :datatype *xml-date*)) + (is-true (type-p me "http://some.where/types/Event")) + (is-true + (property-p me *sw-arc* "place" + :resource + "http://some.where/city/Weimar"))))))) + + +(test test-dateRange-zauberlehrling + "Tests the node of zauberlehrling's dateRange." + (with-fixture rdf-exporter-test-db () + (let ((dr-id (concatenate + 'string "id_" + (write-to-string + (elephant::oid + (d:topic + (elephant:get-instance-by-value 'd:OccurrenceC + 'd:charvalue + "01.01.1797"))))))) + (is-true dr-id) + (let ((drs (get-resources-by-id dr-id))) + (is (= (length drs) 1)) + (let ((me (elt drs 0))) + (is-true (literal-p me *sw-arc* "start" "01.01.1797" + :datatype *xml-date*)) + (is-true (literal-p me *sw-arc* "end" "31.12.1797" + :datatype *xml-date*))))))) + + +(test test-dateRange-erlkoenig + "Tests the node of erlkoenig's dateRange." + (with-fixture rdf-exporter-test-db () + (let ((dr-id (concatenate + 'string "id_" + (write-to-string + (elephant::oid + (d:topic + (elephant:get-instance-by-value 'd:OccurrenceC + 'd:charvalue + "01.01.1782"))))))) + (is-true dr-id) + (let ((drs (get-resources-by-id dr-id))) + (is (= (length drs) 1)) + (let ((me (elt drs 0))) + (is-true (literal-p me *sw-arc* "start" "01.01.1782" + :datatype *xml-date*)) + (is-true (literal-p me *sw-arc* "end" "31.12.1782" + :datatype *xml-date*))))))) + + +(test test-dateRange-prometheus + "Tests the node of prometheus' dateRange." + (with-fixture rdf-exporter-test-db () + (let ((dr-id (concatenate + 'string "id_" + (write-to-string + (elephant::oid + (d:topic + (elephant:get-instance-by-value 'd:OccurrenceC + 'd:charvalue + "01.01.1772"))))))) + (is-true dr-id) + (let ((drs (get-resources-by-id dr-id))) + (is (= (length drs) 1)) + (let ((me (elt drs 0))) + (is-true (literal-p me *sw-arc* "start" "01.01.1772" + :datatype *xml-date*)) + (is-true (literal-p me *sw-arc* "end" "31.12.1774" + :datatype *xml-date*))))))) + + +(test test-schiller + "Tests the node of schiller." + (with-fixture rdf-exporter-test-db () + (let ((schiller-id (concatenate + 'string "id_" + (write-to-string + (elephant::oid + (d:topic + (elephant:get-instance-by-value + 'd:OccurrenceC 'd:charvalue + "http://de.wikipedia.org/wiki/Schiller"))))))) + (is-true schiller-id) + (is (= (length (get-resources-by-id schiller-id)) 1)) + (let ((me (elt (get-resources-by-id schiller-id) 0))) + (is-true (type-p me "http://some.where/types/Author")) + (is-true (type-p me (concatenate 'string *tm2rdf-ns* "Topic"))) + (is-true (literal-p me *sw-arc* "authorInfo" + "http://de.wikipedia.org/wiki/Schiller" + :datatype *xml-uri*)) + (is-true + (name-p me "http://some.where/relationship/firstName" + nil nil "Johann Christoph Friedrich" + :variants + (list + (list + :item-identifiers + (list "http://some.where/variant_ii_1") + :scopes + (list "http://www.topicmaps.org/xtm/1.0/core.xtm#display") + :value "Friedrich" + :datatype *xml-string*)))) + (is-true + (name-p me "http://some.where/relationship/lastName" + nil nil "von Schiller")))))) + + +(test test-single-nodes + "Tests all nodes that are not part of a statement." + (with-fixture rdf-exporter-test-db () + (let ((authors (get-resources-by-uri "http://some.where/types/Author")) + (events (get-resources-by-uri "http://some.where/types/Event")) + (country (get-resources-by-uri "http://some.where/types/Country")) + (poem (get-resources-by-uri "http://some.where/types/Poem")) + (ballad (get-resources-by-uri "http://some.where/types/Ballad")) + (language (get-resources-by-uri "http://some.where/types/Language")) + (rdf-nil (get-resources-by-uri (concatenate 'string *rdf-ns* "nil")))) + (is-true authors) + (is (= (length authors) 1)) + (is (= (length (dom:child-nodes (elt authors 0))) 0)) + (is-true events) + (is (= (length events) 1)) + (is (= (length (dom:child-nodes (elt events 0))) 0)) + (is-true country) + (is (= (length country) 1)) + (is (= (length (dom:child-nodes (elt country 0))) 0)) + (is-true poem) + (is (= (length poem) 1)) + (is (= (length (dom:child-nodes (elt poem 0))) 0)) + (is-true ballad) + (is (= (length ballad) 1)) + (is (= (length (dom:child-nodes (elt ballad 0))) 0)) + (is-true language) + (is (= (length language) 1)) + (is (= (length (dom:child-nodes (elt language 0))) 0)) + (is-true rdf-nil) + (is (= (length rdf-nil) 1)) + (is (= (length (dom:child-nodes (elt rdf-nil 0))) 0))))) + + +(test test-collection + "Tests a collection that has be exported as a construct of rdf:first, + rdf:rest and rdf:nil." + (with-fixture rdf-exporter-test-db () + (let ((goethes (get-resources-by-uri "http://some.where/author/Goethe"))) + (let ((wrote-goethe + (loop for item across (dom:child-nodes (elt goethes 0)) + when (let ((node-ns (dom:namespace-uri item)) + (node-name (rdf-importer::get-node-name item))) + (and (string= node-ns *sw-arc*) + (string= node-name "wrote"))) + return item))) + (let ((id-1 (rdf-importer::get-ns-attribute wrote-goethe"nodeID"))) + (is-true id-1) + (let ((node-1s (get-resources-by-id id-1))) + (is (= (length node-1s) 1)) + (is (= (length (dom:child-nodes (elt node-1s 0))) 2)) + (is-true (property-p (elt node-1s 0) *rdf-ns* "first" + :resource + "http://some.where/poem/Der_Zauberlehrling")) + (let ((rest-arc-1 + (loop for item across (dom:child-nodes (elt node-1s 0)) + when (let ((node-ns (dom:namespace-uri item)) + (node-name (rdf-importer::get-node-name item)) + (nodeID (rdf-importer::get-ns-attribute + item "nodeID"))) + (and (string= node-ns *rdf-ns*) + (string= node-name "rest") + nodeID)) + return item))) + (is-true rest-arc-1) + (let ((id-2 (rdf-importer::get-ns-attribute rest-arc-1 "nodeID"))) + (let ((node-2s (get-resources-by-id id-2))) + (is (= (length node-2s) 1)) + (is (= (length (dom:child-nodes (elt node-2s 0))) 2)) + (is-true (property-p + (elt node-2s 0) *rdf-ns* "first" + :resource + "http://some.where/ballad/Der_Erlkoenig")) + (let ((rest-arc-2 + (loop for item across (dom:child-nodes (elt node-2s 0)) + when (let ((node-ns (dom:namespace-uri item)) + (node-name (rdf-importer::get-node-name item)) + (nodeID (rdf-importer::get-ns-attribute + item "nodeID"))) + (and (string= node-ns *rdf-ns*) + (string= node-name "rest") + nodeID)) + return item))) + (is-true rest-arc-2) + (let ((id-3 (rdf-importer::get-ns-attribute rest-arc-2 + "nodeID"))) + (let ((node-3s (get-resources-by-id id-3))) + (is (= (length node-3s) 1)) + (is (= (length (dom:child-nodes (elt node-3s 0))) 2)) + (is-true (property-p + (elt node-3s 0) *rdf-ns* "first" + :resource + "http://some.where/poem/Prometheus")) + (is-true + (property-p + (elt node-3s 0) *rdf-ns* "rest" + :resource + (concatenate 'string *rdf-ns* "nil"))))))))))))))) + + +(test test-association + "Tests a TM association with four roles and one item-identifier." + (with-fixture rdf-exporter-test-db () + (let ((assoc-id (elephant::oid + (d:identified-construct + (elephant:get-instance-by-value + 'd:ItemIdentifierC 'd:uri + "http://some.where/test-association"))))) + (is-true assoc-id) + (let ((assocs (get-resources-by-id + (concatenate 'string "id_" (write-to-string assoc-id))))) + (is (= (length assocs))) + (let ((me (elt assocs 0))) + (is (= (length (dom:child-nodes me)) 7)) + (is-true (type-p me (concatenate 'string *tm2rdf-ns* "Association"))) + (is-true (identifier-p me "http://some.where/test-association")) + (is-true (property-p me *tm2rdf-ns* "associationtype" + :resource (concatenate + 'string *sw-arc* + "associatedWithEachOther"))) + (is-true (role-p me "http://some.where/roletype/writer" + nil :player-uri "http://some.where/author/Goethe")) + + (let ((schiller-id (concatenate + 'string "id_" + (write-to-string + (elephant::oid + (d:topic + (elephant:get-instance-by-value + 'd:OccurrenceC 'd:charvalue + "http://de.wikipedia.org/wiki/Schiller"))))))) + (is-true (role-p me "http://some.where/roletype/writer" + nil :player-id schiller-id))) + (is-true (role-p me "http://some.where/roletype/literature" + nil :player-uri "http://some.where/types/Poem")) + (is-true (role-p me "http://some.where/roletype/literature" + (list "http://some.where/test-role") + :player-uri "http://some.where/types/Ballad"))))))) + + + + +(defun run-rdf-exporter-tests() + "Runs all test cases of this suite." + (when elephant:*store-controller* + (elephant:close-store)) + (it.bese.fiveam:run! 'test-resources) + (it.bese.fiveam:run! 'test-goethe) + (it.bese.fiveam:run! 'test-erlkoenig) + (it.bese.fiveam:run! 'test-prometheus) + (it.bese.fiveam:run! 'test-zauberlehrling) + (it.bese.fiveam:run! 'test-frankfurt) + (it.bese.fiveam:run! 'test-weimar) + (it.bese.fiveam:run! 'test-berlin) + (it.bese.fiveam:run! 'test-region) + (it.bese.fiveam:run! 'test-city-and-metropolis) + (it.bese.fiveam:run! 'test-germany) + (it.bese.fiveam:run! 'test-german) + (it.bese.fiveam:run! 'test-born-event) + (it.bese.fiveam:run! 'test-died-event) + (it.bese.fiveam:run! 'test-dateRange-zauberlehrling) + (it.bese.fiveam:run! 'test-dateRange-erlkoenig) + (it.bese.fiveam:run! 'test-dateRange-prometheus) + (it.bese.fiveam:run! 'test-schiller) + (it.bese.fiveam:run! 'test-single-nodes) + (it.bese.fiveam:run! 'test-collection) + (it.bese.fiveam:run! 'test-association)) \ No newline at end of file

1 0

[isidorus-cvs] r122 - trunk/src/unit_tests
by Lukas Giessmann 27 Aug '09

27 Aug '09

Author: lgiessmann Date: Thu Aug 27 06:48:16 2009 New Revision: 122 Log: rdf-exporter: updated all unit tests to the last changes Modified: trunk/src/unit_tests/poems_light.xtm Modified: trunk/src/unit_tests/poems_light.xtm ============================================================================== --- trunk/src/unit_tests/poems_light.xtm (original) +++ trunk/src/unit_tests/poems_light.xtm Thu Aug 27 06:48:16 2009 @@ -148,7 +148,7 @@ </tm:topic> <tm:topic id="prometheus"> - <tm:subjectIdentifier href="http://some.where/ballad/Prometheus"/> + <tm:subjectIdentifier href="http://some.where/poem/Prometheus"/> <tm:instanceOf><tm:topicRef href="#poem"/></tm:instanceOf> <tm:occurrence> <tm:type><tm:topicRef href="#title"/></tm:type>

1 0

[isidorus-cvs] r121 - trunk/src/xml/rdf
by Lukas Giessmann 27 Aug '09

27 Aug '09

Author: lgiessmann Date: Thu Aug 27 05:10:55 2009 New Revision: 121 Log: rdf-exporter: changed the handling of associations that were mapped from rdf->tm, thus currently the rdf-mapped associatons are exported directly as rdf-property within an rdf-resource-node. rdf:_n is transformed to rdf:li, therefor associations rdf-mapped-associations and occurrences that will be mapped as usual rdf-properties are sorted by there type-psi; note all unit tests has to be updated, since the exported dom has a different structure Modified: trunk/src/xml/rdf/exporter.lisp Modified: trunk/src/xml/rdf/exporter.lisp ============================================================================== --- trunk/src/xml/rdf/exporter.lisp (original) +++ trunk/src/xml/rdf/exporter.lisp Thu Aug 27 05:10:55 2009 @@ -24,23 +24,54 @@ (:import-from :isidorus-threading with-reader-lock with-writer-lock) - (:import-from :exporter - *export-tm* - export-to-elem) (:export :export-rdf)) (in-package :rdf-exporter) +(defvar *export-tm* nil "TopicMap which is exported (nil if all is + to be exported, the same mechanism as + in xtm-exporter") + (defvar *ns-map* nil) ;; ((:prefix <string> :uri <string>)) +(defun rdf-li-or-uri (uri) + "Returns a string which represents an URI. If the given URI is + of the type rdf:_n there will be returned rdf:li." + (let ((rdf-len (length *rdf-ns*))) + (let ((prep-uri (when (string-starts-with + uri (concatenate 'string *rdf-ns* "_")) + (subseq uri (+ rdf-len 1))))) + (if prep-uri + (handler-case (progn + (parse-integer prep-uri) + (concatenate 'string *rdf-ns* "li")) + (condition () uri)) + uri)))) + + +(defun init-*ns-map* () + "Initializes the variable *ns-map* woith some prefixes and corresponding + namepsaces. So the predifend namespaces are not contain ed twice." + (setf *ns-map* (list + (list :prefix "isi" + :uri *tm2rdf-ns*) + (list :prefix "rdf" + :uri *rdf-ns*) + (list :prefix "rdfs" + :uri *rdfs-ns*) + (list :prefix "xml" + :uri *xml-ns*)))) + + (defmacro with-property (construct &body body) "Generates a property element with a corresponding namespace and tag name before executing the body. This macro is for usin in occurrences and association that are mapped to RDF properties." `(let ((ns-list - (separate-uri (uri (first (psis (instance-of ,construct))))))) + (separate-uri (rdf-li-or-uri + (uri (first (psis (instance-of ,construct)))))))) (declare ((or OccurrenceC AssociationC) ,construct)) (let ((ns (getf ns-list :prefix)) (tag-name (getf ns-list :suffix))) @@ -50,12 +81,34 @@ ,@body))))) +(defmacro export-to-elem (tm to-elem) + "Exports all topics and associations depending to the given + tm. If tm is nil all topics and associations are exported. + Thic macro is equal to the one in xtm-exporter with a different + handler for associations." + `(setf *export-tm* ,tm) + `(format t "*export-tm*: ~a" *export-tm*) + `(map 'list + ,to-elem + (remove-if + #'null + (map 'list + #'(lambda(top) + (d:find-item-by-revision top revision)) + (if ,tm + (union + (d:topics ,tm) (d:associations ,tm)) + (union + (elephant:get-instances-by-class 'd:TopicC) + (list-tm-associations))))))) + + (defun export-rdf (rdf-path &key tm-id (revision (get-revision))) "Exports the topoic map bound to tm-id as RDF." (with-reader-lock (let ((tm (when tm-id (get-item-by-item-identifier tm-id :revision revision)))) - (setf *ns-map* nil) + (init-*ns-map*) (setf *export-tm* tm) (with-revision revision (with-open-file (stream rdf-path :direction :output) @@ -288,7 +341,8 @@ (ii (item-identifiers construct)) (sl (locators construct)) (t-names (names construct)) - (t-occs (occurrences construct))) + (t-occs (occurrences construct)) + (t-assocs (list-rdf-mapped-associations construct))) (if psi (cxml:attribute "rdf:about" (uri psi)) (cxml:attribute "rdf:nodeID" (make-object-id construct))) @@ -308,7 +362,20 @@ (make-topic-reference x))) (list-super-types construct)) (map 'list #'to-rdf-elem t-names) - (map 'list #'to-rdf-elem t-occs))))) + (map 'list #'to-rdf-elem (sort-constructs + (union t-occs t-assocs))))))) + + +(defun sort-constructs (constructs) + "Sorts names and associations by the instance-of name. + So rdf:_n can be exported in the correct order." + (sort constructs #'(lambda(x y) + (declare ((or OccurrenceC AssociationC) x y)) + (let ((x-psi (when (psis (instance-of x)) + (uri (first (psis (instance-of x)))))) + (y-psi (when (psis (instance-of y)) + (uri (first (psis (instance-of y))))))) + (string< x-psi y-psi))))) (defmethod to-rdf-elem ((construct AssociationC)) @@ -387,12 +454,52 @@ association-roles))) (when (and subject-role object-role (= (length association-roles) 2)) - (cxml:with-element "rdf:Description" - (let ((psi (when (psis (player subject-role)) - (first (psis (player subject-role)))))) - (if psi - (cxml:attribute "rdf:about" (uri psi)) - (cxml:attribute "rdf:nodeID" - (make-object-id (player subject-role)))) - (with-property association - (make-topic-reference (player object-role))))))))) \ No newline at end of file + (with-property association + (make-topic-reference (player object-role))))))) + + +(defun list-rdf-mapped-associations(subject-topic) + "Returns all associations that were mapped from RDF to TM + and are still having two roles of the type isi:subject and + isi:object." + (declare (TopicC subject-topic)) + (let ((isi-subject (get-item-by-psi *rdf2tm-subject*)) + (isi-object (get-item-by-psi *rdf2tm-object*))) + (let ((topic-roles + (remove-if + #'null + (map 'list + #'(lambda(x) + (when (and (eql (instance-of x) isi-subject) + (= (length (roles (parent x))) 2) + (find-if #'(lambda(y) + (eql (instance-of y) isi-object)) + (roles (parent x)))) + x)) + (player-in-roles subject-topic))))) + (map 'list #'parent topic-roles)))) + + +(defun list-tm-associations() + "Returns a list of associations that were not mapped from RDF + and are not of the type type-instance or supertype-subtype." + (let ((isi-subject (get-item-by-psi *rdf2tm-subject*)) + (isi-object (get-item-by-psi *rdf2tm-object*)) + (type-instance (get-item-by-psi *type-instance-psi*)) + (supertype-subtype (get-item-by-psi *supertype-subtype-psi*))) + (remove-if + #'null + (map 'list + #'(lambda(x) + (when (and + (not (or (eql (instance-of x) type-instance) + (eql (instance-of x) supertype-subtype))) + (or (/= (length (roles x)) 2) + (not (find-if #'(lambda(y) + (eql (instance-of y) isi-object)) + (roles x))) + (not (find-if #'(lambda(y) + (eql (instance-of y) isi-subject)) + (roles x))))) + x)) + (elephant:get-instances-by-class 'AssociationC))))) \ No newline at end of file

1 0

[isidorus-cvs] r120 - in trunk/src: . unit_tests xml/rdf
by Lukas Giessmann 26 Aug '09

26 Aug '09

Author: lgiessmann Date: Wed Aug 26 12:24:42 2009 New Revision: 120 Log: rdf:exporter: added the macro with-property and some unit tests Modified: trunk/src/isidorus.asd trunk/src/unit_tests/fixtures.lisp trunk/src/unit_tests/poems_light.xtm trunk/src/unit_tests/rdf_importer_test.lisp trunk/src/unit_tests/unittests-constants.lisp trunk/src/xml/rdf/exporter.lisp Modified: trunk/src/isidorus.asd ============================================================================== --- trunk/src/isidorus.asd (original) +++ trunk/src/isidorus.asd Wed Aug 26 12:24:42 2009 @@ -138,6 +138,8 @@ :depends-on ("fixtures")) (:file "threading_test") (:file "rdf_importer_test" + :depends-on ("fixtures")) + (:file "rdf_exporter_test" :depends-on ("fixtures"))) :depends-on ("atom" "constants" Modified: trunk/src/unit_tests/fixtures.lisp ============================================================================== --- trunk/src/unit_tests/fixtures.lisp (original) +++ trunk/src/unit_tests/fixtures.lisp Wed Aug 26 12:24:42 2009 @@ -30,7 +30,7 @@ :merge-test-db :set-up-test-db :tear-down-test-db - + :rdf-exporter-test-db :*TEST-TM* :*NOTIFICATIONBASE-TM* :*XTM-TM* @@ -191,4 +191,23 @@ :document-id document-id) (elephant:open-store (xml-importer:get-store-spec db-dir)) (&body) + (tear-down-test-db))) + + +(def-fixture rdf-exporter-test-db() + (let ((db-dir "data_base") + (tm-id "http://test-tm") + (document-id "doc-id") + (exported-file-path "./__out__.rdf")) + (clean-out-db db-dir) + (handler-case (delete-file exported-file-path) + (error () )) ;do nothing + (setf d:*current-xtm* document-id) + (setup-repository *poems_light.xtm* db-dir :tm-id tm-id + :xtm-id document-id) + (elephant:open-store (xml-importer:get-store-spec db-dir)) + (rdf-exporter:export-rdf exported-file-path :tm-id tm-id) + (&body) + (handler-case (delete-file exported-file-path) + (error () )) ;do nothing (tear-down-test-db))) \ No newline at end of file Modified: trunk/src/unit_tests/poems_light.xtm ============================================================================== --- trunk/src/unit_tests/poems_light.xtm (original) +++ trunk/src/unit_tests/poems_light.xtm Wed Aug 26 12:24:42 2009 @@ -7,6 +7,7 @@ <tm:subjectIdentifier href="http://some.where/author/Goethe"/> <tm:instanceOf><tm:topicRef href="#author"/></tm:instanceOf> <tm:name> + <tm:itemIdentity href="http://some.where/name_ii_1"/> <tm:type><tm:topicRef href="#firstName"/></tm:type> <tm:value>Johann Wolfgang</tm:value> </tm:name> @@ -17,7 +18,7 @@ </tm:topic> <tm:topic id="UUID-born-event"> - <tm:instanceOf href="#event"/> + <tm:instanceOf><tm:topicRef href="#event"/></tm:instanceOf> <tm:occurrence> <tm:type><tm:topicRef href="#date"/></tm:type> <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#date">28.08.1749</tm:resourceData> @@ -55,6 +56,10 @@ <tm:subjectIdentifier href="http://some.where/metropolis/Berlin"/> <tm:instanceOf><tm:topicRef href="#metropolis"/></tm:instanceOf> <tm:occurrence> + <tm:type><tm:topicRef href="#fullName"/></tm:type> + <tm:resourceData>Berlin</tm:resourceData> + </tm:occurrence> + <tm:occurrence> <tm:type><tm:topicRef href="#population"/></tm:type> <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#unsignedLong">3431473</tm:resourceData> </tm:occurrence> @@ -72,6 +77,10 @@ <tm:subjectIdentifier href="http://some.where/city/Weimar"/> <tm:instanceOf><tm:topicRef href="#city"/></tm:instanceOf> <tm:occurrence> + <tm:type><tm:topicRef href="#fullName"/></tm:type> + <tm:resourceData>Weimar</tm:resourceData> + </tm:occurrence> + <tm:occurrence> <tm:type><tm:topicRef href="#population"/></tm:type> <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#unsignedLong">64720</tm:resourceData> </tm:occurrence> @@ -86,6 +95,8 @@ <tm:subjectLocator href="http://some.where/resource_2"/> <tm:instanceOf><tm:topicRef href="#poem"/></tm:instanceOf> <tm:occurrence> + <tm:itemIdentity href="http://some.where/occurrence_ii_1"/> + <tm:itemIdentity href="http://some.where/occurrence_ii_2"/> <tm:type><tm:topicRef href="#title"/></tm:type> <tm:scope> <tm:topicRef href="#de"/> @@ -147,7 +158,7 @@ <tm:occurrence> <tm:type><tm:topicRef href="#content"/></tm:type> <tm:scope><tm:topicRef href="#de"/></tm:scope> - <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string"> Bedecke deinen Himmel, Zeus, ... </tm:resourceData> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string">Bedecke deinen Himmel, Zeus, ...</tm:resourceData> </tm:occurrence> </tm:topic> @@ -284,7 +295,7 @@ </tm:topic> <tm:topic id="lastName"> - <tm:subjectIdentifier href="http://some.where/relationsip/lastName"/> + <tm:subjectIdentifier href="http://some.where/relationship/lastName"/> </tm:topic> <tm:topic id="event"> @@ -589,6 +600,11 @@ <tm:name> <tm:type><tm:topicRef href="#firstName"/></tm:type> <tm:value>Johann Christoph Friedrich</tm:value> + <tm:variant> + <tm:itemIdentity href="http://some.where/variant_ii_1"/> + <tm:scope><tm:topicRef href="#display"/></tm:scope> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string">Friedrich</tm:resourceData> + </tm:variant> </tm:name> <tm:name> <tm:type><tm:topicRef href="#lastName"/></tm:type> @@ -600,6 +616,10 @@ </tm:occurrence> </tm:topic> + <tm:topic id="display"> + <tm:subjectIdentifier href="http://www.topicmaps.org/xtm/1.0/core.xtm#display"/> + </tm:topic> + <tm:topic id="associatedWithEachOther"> <tm:subjectIdentifier href="http://some.where/relationship/associatedWithEachOther"/> </tm:topic> @@ -628,6 +648,7 @@ <tm:topicRef href="#poem"/> </tm:role> <tm:role> + <tm:itemIdentity href="http://some.where/test-role"/> <tm:type><tm:topicRef href="#literature"/></tm:type> <tm:topicRef href="#ballad"/> </tm:role> 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 Wed Aug 26 12:24:42 2009 @@ -32,8 +32,7 @@ *rdf-subject* *rdf-object* *rdf-predicate* - *rdf-statement* - *xml-string*) + *rdf-statement*) (:import-from :xml-tools xpath-child-elems-by-qname xpath-single-child-elem-by-qname Modified: trunk/src/unit_tests/unittests-constants.lisp ============================================================================== --- trunk/src/unit_tests/unittests-constants.lisp (original) +++ trunk/src/unit_tests/unittests-constants.lisp Wed Aug 26 12:24:42 2009 @@ -29,7 +29,8 @@ :*t100.xtm* :*atom_test.xtm* :*atom-conf.lisp* - :*poems_light.rdf*)) + :*poems_light.rdf* + :*poems_light.xtm*)) (in-package :unittests-constants) @@ -93,4 +94,8 @@ (defparameter *poems_light.rdf* (asdf:component-pathname - (asdf:find-component *unit-tests-component* "poems_light.rdf"))) \ No newline at end of file + (asdf:find-component *unit-tests-component* "poems_light.rdf"))) + +(defparameter *poems_light.xtm* + (asdf:component-pathname + (asdf:find-component *unit-tests-component* "poems_light.xtm"))) Modified: trunk/src/xml/rdf/exporter.lisp ============================================================================== --- trunk/src/xml/rdf/exporter.lisp (original) +++ trunk/src/xml/rdf/exporter.lisp Wed Aug 26 12:24:42 2009 @@ -35,6 +35,21 @@ (defvar *ns-map* nil) ;; ((:prefix <string> :uri <string>)) +(defmacro with-property (construct &body body) + "Generates a property element with a corresponding namespace + and tag name before executing the body. This macro is for usin + in occurrences and association that are mapped to RDF properties." + `(let ((ns-list + (separate-uri (uri (first (psis (instance-of ,construct))))))) + (declare ((or OccurrenceC AssociationC) ,construct)) + (let ((ns (getf ns-list :prefix)) + (tag-name (getf ns-list :suffix))) + (cxml:with-namespace ((get-ns-prefix ns) ns) + (cxml:with-element (concatenate 'string (get-ns-prefix ns) + ":" tag-name) + ,@body))))) + + (defun export-rdf (rdf-path &key tm-id (revision (get-revision))) "Exports the topoic map bound to tm-id as RDF." (with-reader-lock @@ -206,6 +221,7 @@ properties itemIdentity, scope and value." (cxml:with-element "isi:variant" (cxml:attribute "rdf:parseType" "Resource") + (make-isi-type "Variant") (map 'list #'to-rdf-elem (item-identifiers construct)) (scopes-to-rdf-elems construct) (resourceX-to-rdf-elem construct))) @@ -216,7 +232,7 @@ properties itemIdentity, nametype, value, variant and scope." (cxml:with-element "isi:name" (cxml:attribute "rdf:parseType" "Resource") - (make-isi-type "name") + (make-isi-type "Name") (map 'list #'to-rdf-elem (item-identifiers construct)) (cxml:with-element "isi:nametype" (make-topic-reference (instance-of construct))) @@ -240,24 +256,18 @@ (/= (length (psis (instance-of construct))) 1)) (cxml:with-element "isi:occurrence" (cxml:attribute "rdf:parseType" "Resource") - (make-isi-type "occurrence") + (make-isi-type "Occurrence") (map 'list #'to-rdf-elem (item-identifiers construct)) (cxml:with-element "isi:occurrencetype" (make-topic-reference (instance-of construct))) (scopes-to-rdf-elems construct) (resourceX-to-rdf-elem construct)) - (let ((ns-list - (separate-uri (uri (first (psis (instance-of construct))))))) - (let ((ns (getf ns-list :prefix)) - (tag-name (getf ns-list :suffix))) - (cxml:with-namespace ((get-ns-prefix ns) ns) - (cxml:with-element (concatenate 'string (get-ns-prefix ns) - ":" tag-name) - (cxml:attribute "rdf:datatype" (datatype construct)) - (when (themes construct) - (cxml:attribute "xml:lang" (get-xml-lang - (first (themes construct))))) - (cxml:text (charvalue construct))))))))) + (with-property construct + (cxml:attribute "rdf:datatype" (datatype construct)) + (when (themes construct) + (cxml:attribute "xml:lang" (get-xml-lang + (first (themes construct))))) + (cxml:text (charvalue construct)))))) (defmethod to-rdf-elem ((construct TopicC)) @@ -269,9 +279,9 @@ (occurrences construct))) (or (used-as-type construct) (used-as-theme construct) - (player-in-roles construct))) + (xml-lang-p construct))) nil ;; do not export this topic explicitly, since it has been exported as - ;; rdf:resource, rdf:about or any other reference + ;; rdf:resource, property or any other reference (cxml:with-element "rdf:Description" (let ((psi (when (psis construct) (first (psis construct)))) @@ -285,7 +295,7 @@ (when (or (> (length (psis construct)) 1) ii sl t-names (isi-occurrence-p construct)) - (make-isi-type "topic")) + (make-isi-type "Topic")) (map 'list #'to-rdf-elem (remove psi (psis construct))) (map 'list #'to-rdf-elem sl) (map 'list #'to-rdf-elem ii) @@ -336,7 +346,7 @@ (association-roles (roles association))) (cxml:with-element "rdf:Description" (cxml:attribute "rdf:nodeID" (make-object-id association)) - (make-isi-type "association") + (make-isi-type "Association") (cxml:with-element "isi:associationtype" (make-topic-reference association-type)) (map 'list #'to-rdf-elem ii) @@ -352,7 +362,7 @@ (player-top (player construct))) (cxml:with-element "isi:role" (cxml:attribute "rdf:parseType" "Resource") - (make-isi-type "role") + (make-isi-type "Role") (map 'list #'to-rdf-elem ii) (cxml:with-element "isi:roletype" (make-topic-reference role-type)) @@ -384,12 +394,5 @@ (cxml:attribute "rdf:about" (uri psi)) (cxml:attribute "rdf:nodeID" (make-object-id (player subject-role)))) - (let ((ns-list - (separate-uri (uri - (first (psis (instance-of association))))))) - (let ((ns (getf ns-list :prefix)) - (tag-name (getf ns-list :suffix))) - (cxml:with-namespace ((get-ns-prefix ns) ns) - (cxml:with-element (concatenate 'string (get-ns-prefix ns) - ":" tag-name) - (make-topic-reference (player object-role)))))))))))) \ No newline at end of file + (with-property association + (make-topic-reference (player object-role))))))))) \ No newline at end of file

1 0

[isidorus-cvs] r119 - trunk/src/xml/rdf
by Lukas Giessmann 25 Aug '09

25 Aug '09

Author: lgiessmann Date: Tue Aug 25 08:06:11 2009 New Revision: 119 Log: rdf-exporter: added the type isi:topic that is used in nodes representing topics that owns more than one psis or item-identifiers, subject-locators, names and occurrences which are represented as isi:occurrence nodes Modified: trunk/src/xml/rdf/exporter.lisp Modified: trunk/src/xml/rdf/exporter.lisp ============================================================================== --- trunk/src/xml/rdf/exporter.lisp (original) +++ trunk/src/xml/rdf/exporter.lisp Tue Aug 25 08:06:11 2009 @@ -140,7 +140,21 @@ (if (psis topic) (cxml:attribute "rdf:resource" (uri (first (psis topic)))) (cxml:attribute "rdf:nodeID" (make-object-id topic)))) - + + +(defun isi-occurrence-p (owner-topic) + "Returns t if the owner topic has an occurrence that will + be mapped to an RDF occurrence node and no an + usual RDF property." + (declare (TopicC owner-topic)) + (loop for occ in (occurrences owner-topic) + when (let ((ii (item-identifiers occ)) + (scopes (loop for scope in (themes occ) + when (not (xml-lang-p scope)) + collect scope))) + (or ii scopes + (> (length (themes occ)) 1))) + return t)) (defgeneric to-rdf-elem (construct) @@ -221,6 +235,7 @@ when (not (xml-lang-p theme)) collect theme)))) (if (or scopes + (> (length (themes construct)) 1) (item-identifiers construct) (/= (length (psis (instance-of construct))) 1)) (cxml:with-element "isi:occurrence" @@ -259,13 +274,21 @@ ;; rdf:resource, rdf:about or any other reference (cxml:with-element "rdf:Description" (let ((psi (when (psis construct) - (first (psis construct))))) + (first (psis construct)))) + (ii (item-identifiers construct)) + (sl (locators construct)) + (t-names (names construct)) + (t-occs (occurrences construct))) (if psi (cxml:attribute "rdf:about" (uri psi)) (cxml:attribute "rdf:nodeID" (make-object-id construct))) + (when (or (> (length (psis construct)) 1) + ii sl t-names + (isi-occurrence-p construct)) + (make-isi-type "topic")) (map 'list #'to-rdf-elem (remove psi (psis construct))) - (map 'list #'to-rdf-elem (locators construct)) - (map 'list #'to-rdf-elem (item-identifiers construct)) + (map 'list #'to-rdf-elem sl) + (map 'list #'to-rdf-elem ii) (map 'list #'(lambda(x) (cxml:with-element "rdf:type" (make-topic-reference x))) @@ -274,8 +297,8 @@ (cxml:with-element "rdfs:subClassOf" (make-topic-reference x))) (list-super-types construct)) - (map 'list #'to-rdf-elem (names construct)) - (map 'list #'to-rdf-elem (occurrences construct)))))) + (map 'list #'to-rdf-elem t-names) + (map 'list #'to-rdf-elem t-occs))))) (defmethod to-rdf-elem ((construct AssociationC))

1 0

[isidorus-cvs] r118 - in trunk/src: unit_tests xml/rdf
by Lukas Giessmann 25 Aug '09

25 Aug '09

Author: lgiessmann Date: Tue Aug 25 05:55:29 2009 New Revision: 118 Log: rdf-exporter: added functions/methods to the exporter module, thus exporting associations is also possible; added the types isi:name, isi:occurrence, isi:role and isi:name for the exported and mapped constructs. Modified: trunk/src/unit_tests/poems_light.xtm trunk/src/xml/rdf/exporter.lisp Modified: trunk/src/unit_tests/poems_light.xtm ============================================================================== --- trunk/src/unit_tests/poems_light.xtm (original) +++ trunk/src/unit_tests/poems_light.xtm Tue Aug 25 05:55:29 2009 @@ -1,9 +1,10 @@ <?xml version="1.0" encoding="UTF-8"?> <tm:topicMap version="2.0" xmlns:tm="http://www.topicmaps.org/xtm/">  + RDF. So certain constructs are not consistent because of test cases, + but all are valid! --> <tm:topic id="goethe"> - <tm:subjectIdentifier href="http://some.where/author/Goehte"/> + <tm:subjectIdentifier href="http://some.where/author/Goethe"/> <tm:instanceOf><tm:topicRef href="#author"/></tm:instanceOf> <tm:name> <tm:type><tm:topicRef href="#firstName"/></tm:type> @@ -77,10 +78,12 @@ </tm:topic> <tm:topic id="zauberlehrling"> - <tm:subectIdentifier href="http://some.where/poem/Der_Zauberlehrling"/> - <tm:subectIdentifier href="http://some.where/poem/Zauberlehrling"/> - <tm:itemIdentity href="http://some.where/poem/Zauberlehrling_itemIdentity"/> - <tm:subjectLocator href="http://some.where/resource"/> + <tm:subjectIdentifier href="http://some.where/poem/Der_Zauberlehrling"/> + <tm:subjectIdentifier href="http://some.where/poem/Zauberlehrling"/> + <tm:itemIdentity href="http://some.where/poem/Zauberlehrling_itemIdentity_1"/> + <tm:itemIdentity href="http://some.where/poem/Zauberlehrling_itemIdentity_2"/> + <tm:subjectLocator href="http://some.where/resource_1"/> + <tm:subjectLocator href="http://some.where/resource_2"/> <tm:instanceOf><tm:topicRef href="#poem"/></tm:instanceOf> <tm:occurrence> <tm:type><tm:topicRef href="#title"/></tm:type> @@ -188,7 +191,7 @@ </tm:topic> <tm:topic id="title"> - <tm:subjetcIdentifier href="http://some.where/relationship/title"/> + <tm:subjectIdentifier href="http://some.where/relationship/title"/> </tm:topic> <tm:topic id="poem"> @@ -465,8 +468,8 @@ </tm:role> </tm:association> -  +  <tm:topic id="wrote"> <tm:subjectIdentifier href="http://some.where/relationship/wrote"/> </tm:topic> @@ -575,4 +578,58 @@ <tm:topicRef href="#nil"/> </tm:role> </tm:association> -</tm:topicMap> \ No newline at end of file + +  + <tm:topic id="authorInfo"> + <tm:subjectIdentifier href="http://some.where/relationship/authorInfo"/> + </tm:topic> + + <tm:topic id="schiller"> + <tm:instanceOf><tm:topicRef href="#author"/></tm:instanceOf> + <tm:name> + <tm:type><tm:topicRef href="#firstName"/></tm:type> + <tm:value>Johann Christoph Friedrich</tm:value> + </tm:name> + <tm:name> + <tm:type><tm:topicRef href="#lastName"/></tm:type> + <tm:value>von Schiller</tm:value> + </tm:name> + <tm:occurrence> + <tm:type><tm:topicRef href="#authorInfo"/></tm:type> + <tm:resourceRef href="http://de.wikipedia.org/wiki/Schiller"/> + </tm:occurrence> + </tm:topic> + + <tm:topic id="associatedWithEachOther"> + <tm:subjectIdentifier href="http://some.where/relationship/associatedWithEachOther"/> + </tm:topic> + + <tm:topic id="writer"> + <tm:subjectIdentifier href="http://some.where/roletype/writer"/> + </tm:topic> + + <tm:topic id="literature"> + <tm:subjectIdentifier href="http://some.where/roletype/literature"/> + </tm:topic> + + <tm:association> + <tm:itemIdentity href="http://some.where/test-association"/> + <tm:type><tm:topicRef href="#associatedWithEachOther"/></tm:type> + <tm:role> + <tm:type><tm:topicRef href="#writer"/></tm:type> + <tm:topicRef href="#schiller"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#writer"/></tm:type> + <tm:topicRef href="#goethe"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#literature"/></tm:type> + <tm:topicRef href="#poem"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#literature"/></tm:type> + <tm:topicRef href="#ballad"/> + </tm:role> + </tm:association> +</tm:topicMap> Modified: trunk/src/xml/rdf/exporter.lisp ============================================================================== --- trunk/src/xml/rdf/exporter.lisp (original) +++ trunk/src/xml/rdf/exporter.lisp Tue Aug 25 05:55:29 2009 @@ -18,7 +18,9 @@ *rdf2tm-object* *rdf2tm-subject* *rdf2tm-scope-prefix* - *tm2rdf-ns*) + *tm2rdf-ns* + *type-instance-psi* + *supertype-subtype-psi*) (:import-from :isidorus-threading with-reader-lock with-writer-lock) @@ -53,7 +55,19 @@ (setf *ns-map* nil)) +(defun make-isi-type (type) + "Creates a rdf:type property with the URL-prefix of *tm2rdf-ns*." + (declare (string type)) + (cxml:with-element "rdf:type" + (cxml:attribute "rdf:resource" (concatenate 'string *tm2rdf-ns* type)))) + + (defun get-ns-prefix (ns-uri) + "Returns a namespace prefix of the form ns<integer> + that is given for a name space during serialization. + This mechanism is needed, since relations in RDF have + a variable tag name and namespace, so this function + uses the namespace map *ns-map*." (let ((ns-entry (find-if #'(lambda(x) (string= (getf x :uri) @@ -71,6 +85,9 @@ (defun separate-uri (uri) + "Returns a plist of the form (:prefix <string> :suffix <string>) + that contains the prefix part of the passed uri and the suffix + part separated by a '/' or '#'." (when (or (not uri) (= (length uri) 0) (and uri @@ -100,6 +117,9 @@ (defun xml-lang-p (topic) + "Returns t if the topic was an imported xml:lang attribute + of RDF/XML. This is the case if the topic has exactly one PSI + with the uri-prefix *rdf2tm-scope-prefix*." (declare (TopicC topic)) (when (= (length (psis topic)) 1) (when (string-starts-with (uri (first (psis topic))) @@ -107,16 +127,19 @@ t))) -(defun make-topic-id (topic) - (declare (TopicC topic)) - (concatenate 'string "id_" (write-to-string (elephant::oid topic)))) +(defun make-object-id (object) + "Returns a string of the form id_<integer> which can be used + as nodeID." + (concatenate 'string "id_" (write-to-string (elephant::oid object)))) (defun make-topic-reference (topic) + "Creates a topic refenrence by using the attributes rdf:resource + or rdf:nodeID, this depends on the PSIS of the topic." (declare (TopicC topic)) (if (psis topic) (cxml:attribute "rdf:resource" (uri (first (psis topic)))) - (cxml:attribute "rdf:nodeID" (make-topic-id topic)))) + (cxml:attribute "rdf:nodeID" (make-object-id topic)))) @@ -125,24 +148,29 @@ (defmethod to-rdf-elem ((construct PersistentIdC)) + "Creates a property which described a PSI." (cxml:with-element "isi:subjectIdentifier" (cxml:attribute "rdf:datatype" *xml-uri*) (cxml:text (uri construct)))) (defmethod to-rdf-elem ((construct SubjectLocatorC)) + "Creates a property which describes a subjectLocator." (cxml:with-element "isi:subjectLocator" (cxml:attribute "rdf:datatype" *xml-uri*) (cxml:text (uri construct)))) (defmethod to-rdf-elem ((construct ItemIdentifierC)) + "Creates a property which creates an itemIdentifier." (cxml:with-element "isi:itemIdentity" (cxml:attribute "rdf:datatype" *xml-uri*) (cxml:text (uri construct)))) (defun scopes-to-rdf-elems (owner-construct) + "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" @@ -151,6 +179,8 @@ (defun resourceX-to-rdf-elem (owner-construct) + "Creates a property that contains a literal value and a datatype + depending on occurrences or variants." (declare ((or OccurrenceC VariantC) owner-construct)) (cxml:with-element "isi:value" (cxml:attribute "rdf:datatype" (datatype owner-construct)) @@ -158,6 +188,8 @@ (defmethod to-rdf-elem ((construct VariantC)) + "Creates a blank node that represents a VariantC element with the + properties itemIdentity, scope and value." (cxml:with-element "isi:variant" (cxml:attribute "rdf:parseType" "Resource") (map 'list #'to-rdf-elem (item-identifiers construct)) @@ -166,8 +198,11 @@ (defmethod to-rdf-elem ((construct NameC)) + "Creates a blank node that represents a name element with the + properties itemIdentity, nametype, value, variant and scope." (cxml:with-element "isi:name" (cxml:attribute "rdf:parseType" "Resource") + (make-isi-type "name") (map 'list #'to-rdf-elem (item-identifiers construct)) (cxml:with-element "isi:nametype" (make-topic-reference (instance-of construct))) @@ -179,6 +214,8 @@ (defmethod to-rdf-elem ((construct OccurrenceC)) + "Creates a blank node that represents an occurrence element with the + properties itemIdentity, occurrencetype, value and scope." (let ((scopes (when (themes construct) (loop for theme in (themes construct) when (not (xml-lang-p theme)) @@ -188,6 +225,7 @@ (/= (length (psis (instance-of construct))) 1)) (cxml:with-element "isi:occurrence" (cxml:attribute "rdf:parseType" "Resource") + (make-isi-type "occurrence") (map 'list #'to-rdf-elem (item-identifiers construct)) (cxml:with-element "isi:occurrencetype" (make-topic-reference (instance-of construct))) @@ -208,25 +246,23 @@ (defmethod to-rdf-elem ((construct TopicC)) - ;TODO: what's with used-as-player and core-topics - (format t "--> ~a " (if (psis construct) - (uri (first (psis construct))) - (make-topic-id construct))) + "Creates a node that describes a TM topic." (if (and (not (or (> (length (psis construct)) 1) (item-identifiers construct) (locators construct) (names construct) (occurrences construct))) (or (used-as-type construct) - (used-as-theme construct))) - nil ;; do not export this topic explicitly, since it is exported as + (used-as-theme construct) + (player-in-roles construct))) + nil ;; do not export this topic explicitly, since it has been exported as ;; rdf:resource, rdf:about or any other reference (cxml:with-element "rdf:Description" (let ((psi (when (psis construct) (first (psis construct))))) (if psi (cxml:attribute "rdf:about" (uri psi)) - (cxml:attribute "rdf:nodeID" (make-topic-id construct))) + (cxml:attribute "rdf:nodeID" (make-object-id construct))) (map 'list #'to-rdf-elem (remove psi (psis construct))) (map 'list #'to-rdf-elem (locators construct)) (map 'list #'to-rdf-elem (item-identifiers construct)) @@ -239,10 +275,98 @@ (make-topic-reference x))) (list-super-types construct)) (map 'list #'to-rdf-elem (names construct)) - (map 'list #'to-rdf-elem (occurrences construct))))) - (format t "<--~%")) + (map 'list #'to-rdf-elem (occurrences construct)))))) (defmethod to-rdf-elem ((construct AssociationC)) - ;TODO: check if the association has to be exported or not - ) \ No newline at end of file + "Exports association elements as RDF properties." + (let ((type-instance (get-item-by-psi *type-instance-psi*)) + (supertype-subtype (get-item-by-psi *supertype-subtype-psi*)) + (association-type (instance-of construct))) + (if (or (eql type-instance association-type) + (eql supertype-subtype association-type)) + nil ;; do nothing, the association has been already exported + ;; either as rdf:type or rdfs:subClassOf + (let ((isi-subject (get-item-by-psi *rdf2tm-subject*)) + (isi-object (get-item-by-psi *rdf2tm-object*)) + (association-roles (roles construct)) + (ii (item-identifiers construct)) + (scopes (themes construct))) + (let ((subject-role (find-if #'(lambda(x) + (eql isi-subject (instance-of x))) + association-roles)) + (object-role (find-if #'(lambda(x) + (eql isi-object (instance-of x))) + association-roles))) + (if (and subject-role object-role (not ii) (not scopes) + (= (length association-roles) 2)) + (rdf-mapped-association-to-rdf-elem construct) + (tm-association-to-rdf-elem construct))))))) + + +(defun tm-association-to-rdf-elem (association) + "Exports a TM association as an RDF resource with special + properties, that descirbes this association." + (declare (AssociationC association)) + (let ((ii (item-identifiers association)) + (association-type (instance-of association)) + (association-roles (roles association))) + (cxml:with-element "rdf:Description" + (cxml:attribute "rdf:nodeID" (make-object-id association)) + (make-isi-type "association") + (cxml:with-element "isi:associationtype" + (make-topic-reference association-type)) + (map 'list #'to-rdf-elem ii) + (scopes-to-rdf-elems association) + (map 'list #'to-rdf-elem association-roles)))) + + +(defmethod to-rdf-elem ((construct RoleC)) + "Exports a TM role as RDF resource with the properties + isi:roletype, isi:itemIdentity and isi:player." + (let ((ii (item-identifiers construct)) + (role-type (instance-of construct)) + (player-top (player construct))) + (cxml:with-element "isi:role" + (cxml:attribute "rdf:parseType" "Resource") + (make-isi-type "role") + (map 'list #'to-rdf-elem ii) + (cxml:with-element "isi:roletype" + (make-topic-reference role-type)) + (cxml:with-element "isi:player" + (make-topic-reference player-top))))) + + +(defun rdf-mapped-association-to-rdf-elem (association) + "Exports an TM association as RDF that was imported from RDF. + This is indicated by the existence of exactly two roles. One + of the type isi:object, the other of the type isi:subject. + Scopes or itemIdentifiers are also forbidden." + (declare (AssociationC association)) + (let ((isi-subject (get-item-by-psi *rdf2tm-subject*)) + (isi-object (get-item-by-psi *rdf2tm-object*)) + (association-roles (roles association))) + (let ((subject-role (find-if #'(lambda(x) + (eql isi-subject (instance-of x))) + association-roles)) + (object-role (find-if #'(lambda(x) + (eql isi-object (instance-of x))) + association-roles))) + (when (and subject-role object-role + (= (length association-roles) 2)) + (cxml:with-element "rdf:Description" + (let ((psi (when (psis (player subject-role)) + (first (psis (player subject-role)))))) + (if psi + (cxml:attribute "rdf:about" (uri psi)) + (cxml:attribute "rdf:nodeID" + (make-object-id (player subject-role)))) + (let ((ns-list + (separate-uri (uri + (first (psis (instance-of association))))))) + (let ((ns (getf ns-list :prefix)) + (tag-name (getf ns-list :suffix))) + (cxml:with-namespace ((get-ns-prefix ns) ns) + (cxml:with-element (concatenate 'string (get-ns-prefix ns) + ":" tag-name) + (make-topic-reference (player object-role)))))))))))) \ No newline at end of file

1 0

[isidorus-cvs] r117 - in trunk/src: . model unit_tests xml/rdf
by Lukas Giessmann 24 Aug '09

24 Aug '09

Author: lgiessmann Date: Mon Aug 24 12:37:40 2009 New Revision: 117 Log: rdf-exporter: implemented a part of the rdf-exporter. currently associations, that do not represent type-instance or supertype-subtype associations are not exported; unit tests are not implemented at the moment, there is just a test file which can be xported "poems_light.xtm" Added: trunk/src/unit_tests/poems_light.xtm Modified: trunk/src/constants.lisp trunk/src/isidorus.asd trunk/src/model/datamodel.lisp trunk/src/unit_tests/poems.rdf trunk/src/unit_tests/poems_light.rdf trunk/src/unit_tests/rdf_importer_test.lisp trunk/src/xml/rdf/exporter.lisp trunk/src/xml/rdf/importer.lisp trunk/src/xml/rdf/rdf_core_psis.xtm trunk/src/xml/rdf/rdf_tools.lisp Modified: trunk/src/constants.lisp ============================================================================== --- trunk/src/constants.lisp (original) +++ trunk/src/constants.lisp Mon Aug 24 12:37:40 2009 @@ -27,6 +27,7 @@ :*xml-ns* :*xmlns-ns* :*xml-string* + :*xml-uri* :*rdf2tm-ns* :*rdf-statement* :*rdf-object* @@ -37,7 +38,8 @@ :*rdf-rest* :*rdf2tm-object* :*rdf2tm-subject* - :*rdf2tm-scope-prefix*)) + :*rdf2tm-scope-prefix* + :*tm2rdf-ns*)) (in-package :constants) (defparameter *xtm2.0-ns* "http://www.topicmaps.org/xtm/") @@ -74,7 +76,9 @@ (defparameter *xml-string* "http://www.w3.org/2001/XMLSchema#string") -(defparameter *rdf2tm-ns* "http://isidorus/rdf2tm_mapping#") +(defparameter *xml-uri* "http://www.w3.org/2001/XMLSchema#anyURI") + +(defparameter *rdf2tm-ns* "http://isidorus/rdf2tm_mapping/") (defparameter *rdf-statement* "http://www.w3.org/1999/02/22-rdf-syntax-ns#Statement") @@ -90,8 +94,10 @@ (defparameter *rdf-rest* "http://www.w3.org/1999/02/22-rdf-syntax-ns#rest") -(defparameter *rdf2tm-object* "http://isidorus/rdf2tm_mapping#object") +(defparameter *rdf2tm-object* "http://isidorus/rdf2tm_mapping/object") + +(defparameter *rdf2tm-subject* "http://isidorus/rdf2tm_mapping/subject") -(defparameter *rdf2tm-subject* "http://isidorus/rdf2tm_mapping#subject") +(defparameter *rdf2tm-scope-prefix* "http://isidorus/rdf2tm_mapping/scope/") -(defparameter *rdf2tm-scope-prefix* "http://isidorus/rdf2tm_mapping/scope#") \ No newline at end of file +(defparameter *tm2rdf-ns* "http://isidorus/tm2rdf_mapping/") \ No newline at end of file Modified: trunk/src/isidorus.asd ============================================================================== --- trunk/src/isidorus.asd (original) +++ trunk/src/isidorus.asd Mon Aug 24 12:37:40 2009 @@ -107,6 +107,7 @@ (:static-file "poems.xtm") (:static-file "poems.rdf") (:static-file "poems_light.rdf") + (:static-file "poems_light.xtm") (:file "atom-conf") (:file "unittests-constants" :depends-on ("dangling_topicref.xtm" Modified: trunk/src/model/datamodel.lisp ============================================================================== --- trunk/src/model/datamodel.lisp (original) +++ trunk/src/model/datamodel.lisp Mon Aug 24 12:37:40 2009 @@ -66,6 +66,7 @@ :item-identifiers :item-identifiers-p :list-instanceOf + :list-super-types :locators :locators-p :make-construct @@ -105,6 +106,8 @@ :*TM-REVISION* :with-revision ;;macros + + :string-starts-with ;;helpers )) (declaim (optimize (debug 3) (safety 3) (speed 0) (space 0))) @@ -647,7 +650,6 @@ (elephant:get-instances-by-value 'PersistentIdC 'uri (uri id)) (elephant:get-instances-by-value 'SubjectLocatorC 'uri (uri id))))) 1) - ;(format t "cfdi: ~A --> ~A~%" construct (item-identifiers construct)) (error (make-condition 'duplicate-identifier-error :message (format nil "Duplicate Identifier ~a has been found" (uri id)) @@ -1174,6 +1176,33 @@ (player-in-roles topic)) (player-in-roles topic))))) + +(defgeneric list-super-types (topic &key tm) + (:documentation "Generate a list of all topics that this topic is an + subclass of, optionally filtered by a topic map")) + + +(defmethod list-super-types ((topic TopicC) &key (tm nil)) + (remove-if + #'null + (map 'list #'(lambda(x) + (when (loop for psi in (psis (instance-of x)) + when (string= (uri psi) *subtype-psi*) + return t) + (loop for role in (roles (parent x)) + when (not (eq role x)) + return (player role)))) + (if tm + (remove-if-not + (lambda (role) + (format t "player: ~a" (player role)) + (format t "parent: ~a" (parent role)) + (format t "topic: ~a~&" topic) + (in-topicmap tm (parent role))) + (player-in-roles topic)) + (player-in-roles topic))))) + + (defun string-starts-with (str prefix) "Checks if string str starts with a given prefix" (declare (string str prefix)) Modified: trunk/src/unit_tests/poems.rdf ============================================================================== --- trunk/src/unit_tests/poems.rdf (original) +++ trunk/src/unit_tests/poems.rdf Mon Aug 24 12:37:40 2009 @@ -248,8 +248,8 @@ <rdf:type rdf:resource="/types/Poem"/> <arcs:dateRange> <rdf:Description xml:base="http://does.not.exist"> - <arcs:start rdf:datatype="http://www.w3.org/2001/XMLSchema#date">1772</arcs:start> - <arcs:end rdf:datatype="http://www.w3.org/2001/XMLSchema#date">1774</arcs:end> + <arcs:start rdf:datatype="http://www.w3.org/2001/XMLSchema#date">01.01.1772</arcs:start> + <arcs:end rdf:datatype="http://www.w3.org/2001/XMLSchema#date">31.12.1774</arcs:end> </rdf:Description> </arcs:dateRange> <arcs:content rdf:parseType="Literal" xml:lang="de"> Modified: trunk/src/unit_tests/poems_light.rdf ============================================================================== --- trunk/src/unit_tests/poems_light.rdf (original) +++ trunk/src/unit_tests/poems_light.rdf Mon Aug 24 12:37:40 2009 @@ -73,119 +73,7 @@ <arcs:start rdf:datatype="#date">01.01.1797</arcs:start> <arcs:end rdf:datatype="#date">31.12.1797</arcs:end> </arcs:dateRange> - <arcs:content xml:lang="de"> - <![CDATA[Hat der alte Hexenmeister -sich doch einmal wegbegeben! -Und nun sollen seine Geister -auch nach meinem Willen leben. -Seine Wort und Werke -merkt ich und den Brauch, -und mit Geistesstärke -tu ich Wunder auch. - -Walle! walle -Manche Strecke, -daß, zum Zwecke, -Wasser fließe -und mit reichem, vollem Schwalle -zu dem Bade sich ergieße. - -Und nun komm, du alter Besen! -Nimm die schlechten Lumpenhüllen; -bist schon lange Knecht gewesen: -nun erfülle meinen Willen! -Auf zwei Beinen stehe, -oben sei ein Kopf, -eile nun und gehe -mit dem Wassertopf! - -Walle! walle -manche Strecke, -daß, zum Zwecke, -Wasser fließe -und mit reichem, vollem Schwalle -zu dem Bade sich ergieße. - -Seht, er läuft zum Ufer nieder, -Wahrlich! ist schon an dem Flusse, -und mit Blitzesschnelle wieder -ist er hier mit raschem Gusse. -Schon zum zweiten Male! -Wie das Becken schwillt! -Wie sich jede Schale -voll mit Wasser füllt! - -Stehe! stehe! -denn wir haben -deiner Gaben -vollgemessen! - -Ach, ich merk es! Wehe! wehe! -Hab ich doch das Wort vergessen! - -Ach, das Wort, worauf am Ende -er das wird, was er gewesen. -Ach, er läuft und bringt behende! -Wärst du doch der alte Besen! -Immer neue Güsse -bringt er schnell herein, -Ach! und hundert Flüsse -stürzen auf mich ein. - -Nein, nicht länger -kann ichs lassen; -will ihn fassen. -Das ist Tücke! -Ach! nun wird mir immer bänger! -Welche Mine! welche Blicke! - -O du Ausgeburt der Hölle! -Soll das ganze Haus ersaufen? -Seh ich über jede Schwelle -doch schon Wasserströme laufen. -Ein verruchter Besen, -der nicht hören will! -Stock, der du gewesen, -steh doch wieder still! - -Willst am Ende -gar nicht lassen? -Will dich fassen, -will dich halten -und das alte Holz behende -mit dem scharfen Beile spalten. - -Seht da kommt er schleppend wieder! -Wie ich mich nur auf dich werfe, -gleich, o Kobold, liegst du nieder; -krachend trifft die glatte Schärfe. -Wahrlich, brav getroffen! -Seht, er ist entzwei! -Und nun kann ich hoffen, -und ich atme frei! - -Wehe! wehe! -Beide Teile -stehn in Eile -schon als Knechte -völlig fertig in die Höhe! -Helft mir, ach! ihr hohen Mächte! - -Und sie laufen! Naß und nässer -wirds im Saal und auf den Stufen. -Welch entsetzliches Gewässer! -Herr und Meister! hör mich rufen! - -Ach, da kommt der Meister! -Herr, die Not ist groß! -Die ich rief, die Geister -werd ich nun nicht los. - -"In die Ecke, -Besen, Besen! -Seids gewesen. -Denn als Geister -ruft euch nur zu diesem Zwecke, -erst hervor der alte Meister."]]> - </arcs:content> + <arcs:content xml:lang="de"><![CDATA[Hat der alte Hexenmeister ...]]></arcs:content> </types:Poem> </rdf:li> </rdf:Bag> @@ -200,47 +88,7 @@ <arcs:start rdf:datatype="#date">01.01.1782</arcs:start> <arcs:end rdf:datatype="#date">31.12.1782</arcs:end> </arcs:dateRange> - <arcs:content rdf:datatype="http://www.w3.org/2001/XMLSchema#string" xml:lang="de"> - <![CDATA[Wer reitet so spät durch Nacht und Wind? -Es ist der Vater mit seinem Kind; -Er hat den Knaben wohl in dem Arm, -Er faßt ihn sicher, er hält ihn warm. - -Mein Sohn, was birgst du so bang dein Gesicht? - -Siehst Vater, du den Erlkönig nicht? -Den Erlenkönig mit Kron und Schweif? - -Mein Sohn, es ist ein Nebelstreif. - - -"Du liebes Kind, komm, geh mit mir! -Gar schöne Spiele spiel ich mit dir; -Manch bunte Blumen sind an dem Strand, -Meine Mutter hat manch gülden Gewand." - -Mein Vater, mein Vater, und hörest du nicht, -Was Erlenkönig mir leise verspricht? - -Sei ruhig, bleibe ruhig, mein Kind; -In dürren Blättern säuselt der Wind. - - -"Willst, feiner Knabe, du mit mir gehn? -Meine Töchter sollen dich warten schön; -Meine Töchter führen den nächtlichen Reihn -Und wiegen und tanzen und singen dich ein." - -Mein Vater, mein Vater, und siehst du nicht dort -Erlkönigs Töchter am düstern Ort? - -Mein Sohn, mein Sohn, ich seh es genau: -Es scheinen die alten Weiden so grau. - - -"Ich liebe dich, mich reizt deine schöne Gestalt; -Und bist du nicht willig, so brauch ich Gewalt." -Mein Vater, mein Vater, jetzt faßt er mich an! -Erlkönig hat mir ein Leids getan! - - -Dem Vater grauset's, er reitet geschwind, -Er hält in den Armen das ächzende Kind, -Erreicht den Hof mit Mühe und Not; -In seinen Armen das Kind war tot.]]> - </arcs:content> + <arcs:content rdf:datatype="http://www.w3.org/2001/XMLSchema#string" xml:lang="de">Wer reitet so spät durch Nacht und Wind? ...</arcs:content> </types:Ballad> </rdf:li> <rdf:li> @@ -248,76 +96,11 @@ <rdf:type rdf:resource="/types/Poem"/> <arcs:dateRange> <rdf:Description xml:base="http://does.not.exist"> - <arcs:start rdf:datatype="http://www.w3.org/2001/XMLSchema#date">1772</arcs:start> - <arcs:end rdf:datatype="http://www.w3.org/2001/XMLSchema#date">1774</arcs:end> + <arcs:start rdf:datatype="http://www.w3.org/2001/XMLSchema#date">01.01.1772</arcs:start> + <arcs:end rdf:datatype="http://www.w3.org/2001/XMLSchema#date">31.12.1774</arcs:end> </rdf:Description> </arcs:dateRange> - <arcs:content rdf:parseType="Literal" xml:lang="de"> - <![CDATA[Bedecke deinen Himmel, Zeus, -Mit Wolkendunst! -Und übe, Knaben gleich, -Der Disteln köpft, -An Eichen dich und Bergeshöh'n! -Mußt mir meine Erde -Doch lassen steh'n, -Und meine Hütte, -Die du nicht gebaut, -Und meinen Herd, -Um dessen Glut -Du mich beneidest. - -Ich kenne nichts Ärmeres -Unter der Sonn' als euch Götter! -Ihr nähret kümmerlich -Von Opfersteuern -Und Gebetshauch -Eure Majestät -Und darbtet, wären -Nicht Kinder und Bettler -Hoffnungsvolle Toren. - -Da ich ein Kind war, -Nicht wußte, wo aus, wo ein, -Kehrt' ich mein verirrtes Auge -Zur Sonne, als wenn drüber wär -Ein Ohr zu hören meine Klage, -Ein Herz wie meins, -Sich des Bedrängten zu erbarmen. - -Wer half mir -Wider der Titanen Übermut? -Wer rettete vom Tode mich, -Von Sklaverei? -Hast du's nicht alles selbst vollendet, -Heilig glühend Herz? -Und glühtest, jung und gut, -Betrogen, Rettungsdank -Dem Schlafenden dadroben? - -Ich dich ehren? Wofür? -Hast du die Schmerzen gelindert -Je des Beladenen? -Hast du die Tränen gestillet -Je des Geängsteten? -Hat nicht mich zum Manne geschmiedet -Die allmächtige Zeit -Und das ewige Schicksal, -Meine Herren und deine? - -Wähntest du etwa, -Ich sollte das Leben hassen, -In Wüsten fliehn, -Weil nicht alle Knabenmorgen- -Blütenträume reiften? - -Hier sitz' ich, forme Menschen -Nach meinem Bilde, -Ein Geschlecht, das mir gleich sei, -Zu leiden, weinen, -Genießen und zu freuen sich, -Und dein nicht zu achten, -Wie ich!]]> - </arcs:content> + <arcs:content rdf:parseType="Literal" xml:lang="de"><![CDATA[ Bedecke deinen Himmel, Zeus, ... ]]></arcs:content> </rdf:Description> </rdf:li> </rdf:Description> Added: trunk/src/unit_tests/poems_light.xtm ============================================================================== --- (empty file) +++ trunk/src/unit_tests/poems_light.xtm Mon Aug 24 12:37:40 2009 @@ -0,0 +1,578 @@ +<?xml version="1.0" encoding="UTF-8"?> +<tm:topicMap version="2.0" xmlns:tm="http://www.topicmaps.org/xtm/"> +  + <tm:topic id="goethe"> + <tm:subjectIdentifier href="http://some.where/author/Goehte"/> + <tm:instanceOf><tm:topicRef href="#author"/></tm:instanceOf> + <tm:name> + <tm:type><tm:topicRef href="#firstName"/></tm:type> + <tm:value>Johann Wolfgang</tm:value> + </tm:name> + <tm:occurrence> + <tm:type><tm:topicRef href="#lastName"/></tm:type> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string">von Goethe</tm:resourceData> + </tm:occurrence> + </tm:topic> + + <tm:topic id="UUID-born-event"> + <tm:instanceOf href="#event"/> + <tm:occurrence> + <tm:type><tm:topicRef href="#date"/></tm:type> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#date">28.08.1749</tm:resourceData> + </tm:occurrence> + </tm:topic> + + <tm:topic id="frankfurt_m"> + <tm:subjectIdentifier href="http://some.where/metropolis/FrankfurtMain"/> + <tm:instanceOf><tm:topicRef href="#metropolis"/></tm:instanceOf> + <tm:occurrence> + <tm:type><tm:topicRef href="#population"/></tm:type> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#unsignedLong">659000</tm:resourceData> + </tm:occurrence> + <tm:occurrence> + <tm:type><tm:topicRef href="#fullName"/></tm:type> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string">Frankfurt am Main</tm:resourceData> + </tm:occurrence> + </tm:topic> + + <tm:topic id="germany"> + <tm:subjectIdentifier href="http://some.where/country/Germany"/> + <tm:instanceOf><tm:topicRef href="#country"/></tm:instanceOf> + <tm:occurrence> + <tm:type><tm:topicRef href="#nativeName"/></tm:type> + <tm:scope><tm:topicRef href="#de"/></tm:scope> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string">Deutschland</tm:resourceData> + </tm:occurrence> + <tm:occurrence> + <tm:type><tm:topicRef href="#population"/></tm:type> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#unsignedLong">82099232</tm:resourceData> + </tm:occurrence> + </tm:topic> + + <tm:topic id="berlin"> + <tm:subjectIdentifier href="http://some.where/metropolis/Berlin"/> + <tm:instanceOf><tm:topicRef href="#metropolis"/></tm:instanceOf> + <tm:occurrence> + <tm:type><tm:topicRef href="#population"/></tm:type> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#unsignedLong">3431473</tm:resourceData> + </tm:occurrence> + </tm:topic> + + <tm:topic id="UUID-died-event"> + <tm:instanceOf><tm:topicRef href="#event"/></tm:instanceOf> + <tm:occurrence> + <tm:type><tm:topicRef href="#date"/></tm:type> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#date">22.03.1832</tm:resourceData> + </tm:occurrence> + </tm:topic> + + <tm:topic id="weimar"> + <tm:subjectIdentifier href="http://some.where/city/Weimar"/> + <tm:instanceOf><tm:topicRef href="#city"/></tm:instanceOf> + <tm:occurrence> + <tm:type><tm:topicRef href="#population"/></tm:type> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#unsignedLong">64720</tm:resourceData> + </tm:occurrence> + </tm:topic> + + <tm:topic id="zauberlehrling"> + <tm:subectIdentifier href="http://some.where/poem/Der_Zauberlehrling"/> + <tm:subectIdentifier href="http://some.where/poem/Zauberlehrling"/> + <tm:itemIdentity href="http://some.where/poem/Zauberlehrling_itemIdentity"/> + <tm:subjectLocator href="http://some.where/resource"/> + <tm:instanceOf><tm:topicRef href="#poem"/></tm:instanceOf> + <tm:occurrence> + <tm:type><tm:topicRef href="#title"/></tm:type> + <tm:scope> + <tm:topicRef href="#de"/> + <tm:topicRef href="#en"/> + </tm:scope> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string">Der Zauberlehrling</tm:resourceData> + </tm:occurrence> + <tm:occurrence> + <tm:type><tm:topicRef href="#content"/></tm:type> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string">Hat der alte Hexenmeister ...</tm:resourceData> + </tm:occurrence> + </tm:topic> + + <tm:topic id="UUID-dateRange-1"> + <tm:occurrence> + <tm:type><tm:topicRef href="#start"/></tm:type> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#date">01.01.1797</tm:resourceData> + </tm:occurrence> + <tm:occurrence> + <tm:type><tm:topicRef href="#end"/></tm:type> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#date">31.12.1797</tm:resourceData> + </tm:occurrence> + </tm:topic> + + <tm:topic id="erlkoenig"> + <tm:subjectIdentifier href="http://some.where/ballad/Der_Erlkoenig"/> + <tm:instanceOf><tm:topicRef href="#ballad"/></tm:instanceOf> + <tm:occurrence> + <tm:type><tm:topicRef href="#title"/></tm:type> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string">Der Erlkönig</tm:resourceData> + <tm:scope><tm:topicRef href="#en"/></tm:scope> + </tm:occurrence> + <tm:occurrence> + <tm:type><tm:topicRef href="#content"/></tm:type> + <tm:scope><tm:topicRef href="#de"/></tm:scope> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string">Wer reitet so spät durch Nacht und Wind? ...</tm:resourceData> + </tm:occurrence> + </tm:topic> + + <tm:topic id="UUID-dateRange-2"> + <tm:occurrence> + <tm:type><tm:topicRef href="#start"/></tm:type> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#date">01.01.1782</tm:resourceData> + </tm:occurrence> + <tm:occurrence> + <tm:type><tm:topicRef href="#end"/></tm:type> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#date">31.12.1782</tm:resourceData> + </tm:occurrence> + </tm:topic> + + <tm:topic id="prometheus"> + <tm:subjectIdentifier href="http://some.where/ballad/Prometheus"/> + <tm:instanceOf><tm:topicRef href="#poem"/></tm:instanceOf> + <tm:occurrence> + <tm:type><tm:topicRef href="#title"/></tm:type> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string">Prometheus</tm:resourceData> + <tm:scope><tm:topicRef href="#de"/></tm:scope> + </tm:occurrence> + <tm:occurrence> + <tm:type><tm:topicRef href="#content"/></tm:type> + <tm:scope><tm:topicRef href="#de"/></tm:scope> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string"> Bedecke deinen Himmel, Zeus, ... </tm:resourceData> + </tm:occurrence> + </tm:topic> + + <tm:topic id="UUID-dateRange-3"> + <tm:occurrence> + <tm:type><tm:topicRef href="#start"/></tm:type> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#date">01.01.1772</tm:resourceData> + </tm:occurrence> + <tm:occurrence> + <tm:type><tm:topicRef href="#end"/></tm:type> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#date">31.12.1774</tm:resourceData> + </tm:occurrence> + </tm:topic> + + <tm:topic id="dateRange"> + <tm:subjectIdentifier href="http://some.where/relationship/dateRange"/> + </tm:topic> + + <tm:topic id="officialese"> + <tm:subjectIdentifier href="http://some.where/relationship/officialese"/> + </tm:topic> + + <tm:topic id="content"> + <tm:subjectIdentifier href="http://some.where/relationship/content"/> + </tm:topic> + + <tm:topic id="start"> + <tm:subjectIdentifier href="http://some.where/relationship/start"/> + </tm:topic> + + <tm:topic id="end"> + <tm:subjectIdentifier href="http://some.where/relationship/end"/> + </tm:topic> + + <tm:topic id="de"> + <tm:subjectIdentifier href="http://isidorus/rdf2tm_mapping/scope/de"/> + </tm:topic> + + <tm:topic id="en"> + <tm:subjectIdentifier href="http://some.where/scope/en"/> + </tm:topic> + + <tm:topic id="title"> + <tm:subjetcIdentifier href="http://some.where/relationship/title"/> + </tm:topic> + + <tm:topic id="poem"> + <tm:subjectIdentifier href="http://some.where/types/Poem"/> + </tm:topic> + + <tm:topic id="ballad"> + <tm:subjectIdentifier href="http://some.where/types/Ballad"/> + </tm:topic> + + <tm:topic id="supertype-subtype"> + <tm:subjectIdentifier href="http://psi.topicmaps.org/iso13250/model/supertype-subtype"/> + </tm:topic> + + <tm:topic id="supertype"> + <tm:subjectIdentifier href="http://psi.topicmaps.org/iso13250/model/supertype"/> + </tm:topic> + + <tm:topic id="subtype"> + <tm:subjectIdentifier href="http://psi.topicmaps.org/iso13250/model/subtype"/> + </tm:topic> + + <tm:topic id="region"> + <tm:subjectIdentifier href="http://some.where/types/Region"/> + </tm:topic> + + <tm:topic id="city"> + <tm:subjectIdentifier href="http://some.where/types/City"/> + </tm:topic> + + <tm:topic id="died"> + <tm:subjectIdentifier href="http://some.where/relationship/died"/> + </tm:topic> + + <tm:topic id="capital"> + <tm:subjectIdentifier href="http://some.where/relationship/capital"/> + </tm:topic> + + <tm:topic id="german"> + <tm:subjectIdentifier href="http://some.where/language/German"/> + <tm:instanceOf><tm:topicRef href="#language"/></tm:instanceOf> + </tm:topic> + + <tm:topic id="language"> + <tm:subjectIdentifier href="http://some.where/types/Language"/> + </tm:topic> + + <tm:topic id="population"> + <tm:subjectIdentifier href="http://some.where/relationship/population"/> + </tm:topic> + + <tm:topic id="nativeName"> + <tm:subjectIdentifier href="http://some.where/relationship/nativeName"/> + </tm:topic> + + <tm:topic id="country"> + <tm:subjectIdentifier href="http://some.where/types/Country"/> + </tm:topic> + + <tm:topic id="metropolis"> + <tm:subjectIdentifier href="http://some.where/types/Metropolis"/> + </tm:topic> + + <tm:topic id="locatedIn"> + <tm:subjectIdentifier href="http://some.where/relationship/locatedIn"/> + </tm:topic> + + <tm:topic id="place"> + <tm:subjectIdentifier href="http://some.where/relationship/place"/> + </tm:topic> + + <tm:topic id="fullName"> + <tm:subjectIdentifier href="http://some.where/relationship/fullName"/> + </tm:topic> + + <tm:topic id="date"> + <tm:subjectIdentifier href="http://some.where/relationship/date"/> + </tm:topic> + + <tm:topic id="born"> + <tm:subjectIdentifier href="http://some.where/relationship/born"/> + </tm:topic> + + <tm:topic id="author"> + <tm:subjectIdentifier href="http://some.where/types/Author"/> + </tm:topic> + + <tm:topic id="firstName"> + <tm:subjectIdentifier href="http://some.where/relationship/firstName"/> + </tm:topic> + + <tm:topic id="lastName"> + <tm:subjectIdentifier href="http://some.where/relationsip/lastName"/> + </tm:topic> + + <tm:topic id="event"> + <tm:subjectIdentifier href="http://some.where/types/Event"/> + </tm:topic> + + <tm:topic id="isi-subject"> + <tm:subjectIdentifier href="http://isidorus/rdf2tm_mapping/subject"/> + </tm:topic> + + <tm:topic id="isi-object"> + <tm:subjectIdentifier href="http://isidorus/rdf2tm_mapping/object"/> + </tm:topic> + + <tm:association> + <tm:type><tm:topicRef href="#born"/></tm:type> + <tm:role> + <tm:type><tm:topicRef href="#isi-subject"/></tm:type> + <tm:topicRef href="#goethe"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#isi-object"/></tm:type> + <tm:topicRef href="#UUID-born-event"/> + </tm:role> + </tm:association> + + <tm:association> + <tm:type><tm:topicRef href="#place"/></tm:type> + <tm:role> + <tm:type><tm:topicRef href="#isi-subject"/></tm:type> + <tm:topicRef href="#UUID-born-event"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#isi-object"/></tm:type> + <tm:topicRef href="#frankfurt_m"/> + </tm:role> + </tm:association> + + <tm:association> + <tm:type><tm:topicRef href="#locatedIn"/></tm:type> + <tm:role> + <tm:type><tm:topicRef href="#isi-subject"/></tm:type> + <tm:topicRef href="#frankfurt_m"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#isi-object"/></tm:type> + <tm:topicRef href="#germany"/> + </tm:role> + </tm:association> + + <tm:association> + <tm:type><tm:topicRef href="#officialese"/></tm:type> + <tm:role> + <tm:type><tm:topicRef href="#isi-subject"/></tm:type> + <tm:topicRef href="#germany"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#isi-object"/></tm:type> + <tm:topicRef href="#german"/> + </tm:role> + </tm:association> + + <tm:association> + <tm:type><tm:topicRef href="#locatedIn"/></tm:type> + <tm:role> + <tm:type><tm:topicRef href="#isi-subject"/></tm:type> + <tm:topicRef href="#berlin"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#isi-object"/></tm:type> + <tm:topicRef href="#germany"/> + </tm:role> + </tm:association> + + <tm:association> + <tm:type><tm:topicRef href="#capital"/></tm:type> + <tm:role> + <tm:type><tm:topicRef href="#isi-subject"/></tm:type> + <tm:topicRef href="#germany"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#isi-object"/></tm:type> + <tm:topicRef href="#berlin"/> + </tm:role> + </tm:association> + + <tm:association> + <tm:type><tm:topicRef href="#died"/></tm:type> + <tm:role> + <tm:type><tm:topicRef href="#isi-subject"/></tm:type> + <tm:topicRef href="#goethe"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#isi-object"/></tm:type> + <tm:topicRef href="#UUID-died-event"/> + </tm:role> + </tm:association> + + <tm:association> + <tm:type><tm:topicRef href="#place"/></tm:type> + <tm:role> + <tm:type><tm:topicRef href="#isi-subject"/></tm:type> + <tm:topicRef href="#UUID-died-event"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#isi-object"/></tm:type> + <tm:topicRef href="#weimar"/> + </tm:role> + </tm:association> + + <tm:association> + <tm:type><tm:topicRef href="#locatedIn"/></tm:type> + <tm:role> + <tm:type><tm:topicRef href="#isi-subject"/></tm:type> + <tm:topicRef href="#weimar"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#isi-object"/></tm:type> + <tm:topicRef href="#germany"/> + </tm:role> + </tm:association> + + <tm:association> + <tm:type><tm:topicRef href="#supertype-subtype"/></tm:type> + <tm:role> + <tm:type><tm:topicRef href="#supertype"/></tm:type> + <tm:topicRef href="#region"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#subtype"/></tm:type> + <tm:topicRef href="#city"/> + </tm:role> + </tm:association> + + <tm:association> + <tm:itemIdentity href="http://some.where/metropolis_supertye-subtype-association"/> + <tm:type><tm:topicRef href="#supertype-subtype"/></tm:type> + <tm:role> + <tm:type><tm:topicRef href="#supertype"/></tm:type> + <tm:topicRef href="#region"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#subtype"/></tm:type> + <tm:topicRef href="#metropolis"/> + </tm:role> + </tm:association> + + <tm:association> + <tm:type><tm:topicRef href="#dateRange"/></tm:type> + <tm:role> + <tm:type><tm:topicRef href="#isi-subject"/></tm:type> + <tm:topicRef href="#zauberlehrling"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#isi-object"/></tm:type> + <tm:topicRef href="#UUID-dateRange-1"/> + </tm:role> + </tm:association> + + <tm:association> + <tm:type><tm:topicRef href="#dateRange"/></tm:type> + <tm:role> + <tm:type><tm:topicRef href="#isi-subject"/></tm:type> + <tm:topicRef href="#erlkoenig"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#isi-object"/></tm:type> + <tm:topicRef href="#UUID-dateRange-2"/> + </tm:role> + </tm:association> + + <tm:association> + <tm:type><tm:topicRef href="#dateRange"/></tm:type> + <tm:role> + <tm:type><tm:topicRef href="#isi-subject"/></tm:type> + <tm:topicRef href="#prometheus"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#isi-object"/></tm:type> + <tm:topicRef href="#UUID-dateRange-3"/> + </tm:role> + </tm:association> + +  + <tm:topic id="wrote"> + <tm:subjectIdentifier href="http://some.where/relationship/wrote"/> + </tm:topic> + + <tm:topic id="rest"> + <tm:subjectIdentifier href="http://www.w3.org/1999/02/22-rdf-syntax-ns#rest"/> + </tm:topic> + + <tm:topic id="first"> + <tm:subjectIdentifier href="http://www.w3.org/1999/02/22-rdf-syntax-ns#first"/> + </tm:topic> + + <tm:topic id="nil"> + <tm:subjectIdentifier href="http://www.w3.org/1999/02/22-rdf-syntax-ns#nil"/> + </tm:topic> + +  + <tm:topic id="UUID-1-collection"/> + + <tm:association> + <tm:type><tm:topicRef href="#wrote"/></tm:type> + <tm:role> + <tm:type><tm:topicRef href="#isi-subject"/></tm:type> + <tm:topicRef href="#goethe"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#isi-object"/></tm:type> + <tm:topicRef href="#UUID-1-collection"/> + </tm:role> + </tm:association> + + <tm:association> + <tm:type><tm:topicRef href="#first"/></tm:type> + <tm:role> + <tm:type><tm:topicRef href="#isi-subject"/></tm:type> + <tm:topicRef href="#UUID-1-collection"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#isi-object"/></tm:type> + <tm:topicRef href="#zauberlehrling"/> + </tm:role> + </tm:association> + + <tm:association> + <tm:type><tm:topicRef href="#rest"/></tm:type> + <tm:role> + <tm:type><tm:topicRef href="#isi-subject"/></tm:type> + <tm:topicRef href="#UUID-1-collection"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#isi-object"/></tm:type> + <tm:topicRef href="#UUID-2-collection"/> + </tm:role> + </tm:association> + +  + <tm:topic id="UUID-2-collection"/> + + <tm:association> + <tm:type><tm:topicRef href="#first"/></tm:type> + <tm:role> + <tm:type><tm:topicRef href="#isi-subject"/></tm:type> + <tm:topicRef href="#UUID-2-collection"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#isi-object"/></tm:type> + <tm:topicRef href="#erlkoenig"/> + </tm:role> + </tm:association> + + <tm:association> + <tm:type><tm:topicRef href="#rest"/></tm:type> + <tm:role> + <tm:type><tm:topicRef href="#isi-subject"/></tm:type> + <tm:topicRef href="#UUID-2-collection"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#isi-object"/></tm:type> + <tm:topicRef href="#UUID-3-collection"/> + </tm:role> + </tm:association> + +  + <tm:topic id="UUID-3-collection"/> + + <tm:association> + <tm:type><tm:topicRef href="#first"/></tm:type> + <tm:role> + <tm:type><tm:topicRef href="#isi-subject"/></tm:type> + <tm:topicRef href="#UUID-3-collection"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#isi-object"/></tm:type> + <tm:topicRef href="#prometheus"/> + </tm:role> + </tm:association> + + <tm:association> + <tm:type><tm:topicRef href="#rest"/></tm:type> + <tm:role> + <tm:type><tm:topicRef href="#isi-subject"/></tm:type> + <tm:topicRef href="#UUID-3-collection"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#isi-object"/></tm:type> + <tm:topicRef href="#nil"/> + </tm:role> + </tm:association> +</tm:topicMap> \ No newline at end of file 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 Mon Aug 24 12:37:40 2009 @@ -1793,7 +1793,7 @@ (prometheus "http://some.where/poem/Prometheus") (erlkoenig "http://some.where/ballad/Der_Erlkoenig") (date "http://www.w3.org/2001/XMLSchema#date") - (de (d:get-item-by-id "http://isidorus/rdf2tm_mapping/scope#de")) + (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 occs) 23)) @@ -1866,6 +1866,7 @@ (string= (d:uri (first (d:psis (d:instance-of x)))) (concatenate 'string arcs "title")) (string= *xml-string* (d:datatype x)) + (string= (d:charvalue x) "Der Zauberlehrling") (= 1 (length (d:themes x))) (eql (first (d:themes x)) de) (= (length (d:psis (d:topic x))) 1) @@ -1879,6 +1880,7 @@ (string= (d:uri (first (d:psis (d:instance-of x)))) (concatenate 'string arcs "title")) (= 0 (length (d:themes x))) + (string= (d:charvalue x) "Prometheus") (string= *xml-string* (d:datatype x)) (= (length (d:psis (d:topic x))) 1) (string= (d:uri (first (d:psis (d:topic x)))) @@ -1891,6 +1893,7 @@ (string= (d:uri (first (d:psis (d:instance-of x)))) (concatenate 'string arcs "title")) (string= *xml-string* (d:datatype x)) + (string= (d:charvalue x) "Der Erlkönig") (= 1 (length (d:themes x))) (eql (first (d:themes x)) de) (= (length (d:psis (d:topic x))) 1) @@ -1904,6 +1907,7 @@ (string= (d:uri (first (d:psis (d:instance-of x)))) (concatenate 'string arcs "content")) (string= *xml-string* (d:datatype x)) + (string= (d:charvalue x) "Hat der alte Hexenmeister ...") (= 1 (length (d:themes x))) (eql (first (d:themes x)) de) (= (length (d:psis (d:topic x))) 1) @@ -1917,6 +1921,8 @@ (string= (d:uri (first (d:psis (d:instance-of x)))) (concatenate 'string arcs "content")) (string= *xml-string* (d:datatype x)) + (string= (d:charvalue x) + " Bedecke deinen Himmel, Zeus, ... ") (= 1 (length (d:themes x))) (eql (first (d:themes x)) de) (= (length (d:psis (d:topic x))) 1) @@ -1930,6 +1936,8 @@ (string= (d:uri (first (d:psis (d:instance-of x)))) (concatenate 'string arcs "content")) (string= *xml-string* (d:datatype x)) + (string= (d:charvalue x) + "Wer reitet so spät durch Nacht und Wind? ...") (= 1 (length (d:themes x))) (eql (first (d:themes x)) de) (= (length (d:psis (d:topic x))) 1) Modified: trunk/src/xml/rdf/exporter.lisp ============================================================================== --- trunk/src/xml/rdf/exporter.lisp (original) +++ trunk/src/xml/rdf/exporter.lisp Mon Aug 24 12:37:40 2009 @@ -4,4 +4,245 @@ ;;+ ;;+ Isidorus is freely distributable under the LGPL license. ;;+ You can find a detailed description in trunk/docs/LGPL-LICENSE.txt. -;;+----------------------------------------------------------------------------- \ No newline at end of file +;;+----------------------------------------------------------------------------- + +(defpackage :rdf-exporter + (:use :cl :cxml :elephant :datamodel :isidorus-threading :datamodel) + (:import-from :constants + *rdf-ns* + *rdfs-ns* + *xml-ns* + *xml-string* + *xml-uri* + *rdf2tm-ns* + *rdf2tm-object* + *rdf2tm-subject* + *rdf2tm-scope-prefix* + *tm2rdf-ns*) + (:import-from :isidorus-threading + with-reader-lock + with-writer-lock) + (:import-from :exporter + *export-tm* + export-to-elem) + (:export :export-rdf)) + +(in-package :rdf-exporter) + + +(defvar *ns-map* nil) ;; ((:prefix <string> :uri <string>)) + + +(defun export-rdf (rdf-path &key tm-id (revision (get-revision))) + "Exports the topoic map bound to tm-id as RDF." + (with-reader-lock + (let ((tm (when tm-id + (get-item-by-item-identifier tm-id :revision revision)))) + (setf *ns-map* nil) + (setf *export-tm* tm) + (with-revision revision + (with-open-file (stream rdf-path :direction :output) + (cxml:with-xml-output (cxml:make-character-stream-sink + stream :canonical nil) + (cxml:with-namespace ("isi" *tm2rdf-ns*) + (cxml:with-namespace ("rdf" *rdf-ns*) + (cxml:with-namespace ("rdfs" *rdfs-ns*) + (cxml:with-namespace ("xml" *xml-ns*) + (cxml:with-element "rdf:RDF" + (export-to-elem tm #'to-rdf-elem))))))))))) + (setf *ns-map* nil)) + + +(defun get-ns-prefix (ns-uri) + (let ((ns-entry + (find-if #'(lambda(x) + (string= (getf x :uri) + ns-uri)) + *ns-map*))) + (if ns-entry + (getf ns-entry :prefix) + (let ((new-name (concatenate + 'string "ns" + (write-to-string (+ 1 (length *ns-map*)))))) + (push (list :prefix new-name + :uri ns-uri) + *ns-map*) + new-name)))) + + +(defun separate-uri (uri) + (when (or (not uri) + (= (length uri) 0) + (and uri + (> (length uri) 0) + (or (eql (elt uri (- (length uri) 1)) #\#) + (eql (elt uri (- (length uri) 1)) #\/) + (eql (elt uri 0) #\#) + (eql (elt uri 0) #\/)))) + (error "From separate-uri(): bad ns-uri: ~a" uri)) + (let ((pos-hash (position #\# uri :from-end t)) + (pos-slash (position #\/ uri :from-end t))) + (unless (or pos-hash pos-slash) + (error "From separate-uri(): bad ns-uri: ~a" uri)) + (if (not (or pos-hash pos-slash)) + (list :prefix *tm2rdf-ns* + :suffix uri) + (let ((prefix (subseq uri 0 (+ (max (or pos-hash 0) (or pos-slash 0)) 1))) + (suffix (subseq uri (+ (max (or pos-hash 0) (or pos-slash 0)) 1)))) + (list :prefix prefix + :suffix suffix))))) + + +(defun get-xml-lang (topic) + (declare (TopicC topic)) + (when (xml-lang-p topic) + (subseq (uri (first (psis topic))) (length *rdf2tm-scope-prefix*)))) + + +(defun xml-lang-p (topic) + (declare (TopicC topic)) + (when (= (length (psis topic)) 1) + (when (string-starts-with (uri (first (psis topic))) + *rdf2tm-scope-prefix*) + t))) + + +(defun make-topic-id (topic) + (declare (TopicC topic)) + (concatenate 'string "id_" (write-to-string (elephant::oid topic)))) + + +(defun make-topic-reference (topic) + (declare (TopicC topic)) + (if (psis topic) + (cxml:attribute "rdf:resource" (uri (first (psis topic)))) + (cxml:attribute "rdf:nodeID" (make-topic-id topic)))) + + + +(defgeneric to-rdf-elem (construct) + (:documentation "Exports Topic Maps Constructs as RDF. ")) + + +(defmethod to-rdf-elem ((construct PersistentIdC)) + (cxml:with-element "isi:subjectIdentifier" + (cxml:attribute "rdf:datatype" *xml-uri*) + (cxml:text (uri construct)))) + + +(defmethod to-rdf-elem ((construct SubjectLocatorC)) + (cxml:with-element "isi:subjectLocator" + (cxml:attribute "rdf:datatype" *xml-uri*) + (cxml:text (uri construct)))) + + +(defmethod to-rdf-elem ((construct ItemIdentifierC)) + (cxml:with-element "isi:itemIdentity" + (cxml:attribute "rdf:datatype" *xml-uri*) + (cxml:text (uri construct)))) + + +(defun scopes-to-rdf-elems (owner-construct) + (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))) + + +(defun resourceX-to-rdf-elem (owner-construct) + (declare ((or OccurrenceC VariantC) owner-construct)) + (cxml:with-element "isi:value" + (cxml:attribute "rdf:datatype" (datatype owner-construct)) + (cxml:text (charvalue owner-construct)))) + + +(defmethod to-rdf-elem ((construct VariantC)) + (cxml:with-element "isi:variant" + (cxml:attribute "rdf:parseType" "Resource") + (map 'list #'to-rdf-elem (item-identifiers construct)) + (scopes-to-rdf-elems construct) + (resourceX-to-rdf-elem construct))) + + +(defmethod to-rdf-elem ((construct NameC)) + (cxml:with-element "isi:name" + (cxml:attribute "rdf:parseType" "Resource") + (map 'list #'to-rdf-elem (item-identifiers construct)) + (cxml:with-element "isi:nametype" + (make-topic-reference (instance-of construct))) + (scopes-to-rdf-elems construct) + (cxml:with-element "isi:value" + (cxml:attribute "rdf:datatype" *xml-string*) + (cxml:text (charvalue construct))) + (map 'list #'to-rdf-elem (variants construct)))) + + +(defmethod to-rdf-elem ((construct OccurrenceC)) + (let ((scopes (when (themes construct) + (loop for theme in (themes construct) + when (not (xml-lang-p theme)) + collect theme)))) + (if (or scopes + (item-identifiers construct) + (/= (length (psis (instance-of construct))) 1)) + (cxml:with-element "isi:occurrence" + (cxml:attribute "rdf:parseType" "Resource") + (map 'list #'to-rdf-elem (item-identifiers construct)) + (cxml:with-element "isi:occurrencetype" + (make-topic-reference (instance-of construct))) + (scopes-to-rdf-elems construct) + (resourceX-to-rdf-elem construct)) + (let ((ns-list + (separate-uri (uri (first (psis (instance-of construct))))))) + (let ((ns (getf ns-list :prefix)) + (tag-name (getf ns-list :suffix))) + (cxml:with-namespace ((get-ns-prefix ns) ns) + (cxml:with-element (concatenate 'string (get-ns-prefix ns) + ":" tag-name) + (cxml:attribute "rdf:datatype" (datatype construct)) + (when (themes construct) + (cxml:attribute "xml:lang" (get-xml-lang + (first (themes construct))))) + (cxml:text (charvalue construct))))))))) + + +(defmethod to-rdf-elem ((construct TopicC)) + ;TODO: what's with used-as-player and core-topics + (format t "--> ~a " (if (psis construct) + (uri (first (psis construct))) + (make-topic-id construct))) + (if (and (not (or (> (length (psis construct)) 1) + (item-identifiers construct) + (locators construct) + (names construct) + (occurrences construct))) + (or (used-as-type construct) + (used-as-theme construct))) + nil ;; do not export this topic explicitly, since it is exported as + ;; rdf:resource, rdf:about or any other reference + (cxml:with-element "rdf:Description" + (let ((psi (when (psis construct) + (first (psis construct))))) + (if psi + (cxml:attribute "rdf:about" (uri psi)) + (cxml:attribute "rdf:nodeID" (make-topic-id construct))) + (map 'list #'to-rdf-elem (remove psi (psis construct))) + (map 'list #'to-rdf-elem (locators construct)) + (map 'list #'to-rdf-elem (item-identifiers construct)) + (map 'list #'(lambda(x) + (cxml:with-element "rdf:type" + (make-topic-reference x))) + (list-instanceOf construct)) + (map 'list #'(lambda(x) + (cxml:with-element "rdfs:subClassOf" + (make-topic-reference x))) + (list-super-types construct)) + (map 'list #'to-rdf-elem (names construct)) + (map 'list #'to-rdf-elem (occurrences construct))))) + (format t "<--~%")) + + +(defmethod to-rdf-elem ((construct AssociationC)) + ;TODO: check if the association has to be exported or not + ) \ 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 Aug 24 12:37:40 2009 @@ -589,7 +589,7 @@ (defun get-literals-of-node-content (node tm-id xml-base xml-lang) "Returns a list of literals that is produced of a node's content." (declare (dom:element node)) - (tm-id-p tm-id "get-literals-of-content") + (tm-id-p tm-id "get-literals-of-noode-content") (let ((properties (child-nodes-or-text node :trim t)) (fn-xml-base (get-xml-base node :old-base xml-base)) (fn-xml-lang (get-xml-lang node :old-lang xml-lang))) @@ -607,7 +607,8 @@ property nil)) (prop-content (child-nodes-or-text property))) (and (or datatype - (string= parseType "Literal") + (and parseType + (string= parseType "Literal")) (and (not (or nodeID resource UUID parseType)) (or (not prop-content) (stringp prop-content)))) Modified: trunk/src/xml/rdf/rdf_core_psis.xtm ============================================================================== --- trunk/src/xml/rdf/rdf_core_psis.xtm (original) +++ trunk/src/xml/rdf/rdf_core_psis.xtm Mon Aug 24 12:37:40 2009 @@ -11,14 +11,14 @@ <topicMap xmlns="http://www.topicmaps.org/xtm/" version="2.0"> <topic id="subject"> - <subjectIdentifier href="http://isidorus/rdf2tm_mapping#subject"/> + <subjectIdentifier href="http://isidorus/rdf2tm_mapping/subject"/> <name> <value>subject</value> </name> </topic> <topic id="object"> - <subjectIdentifier href="http://isidorus/rdf2tm_mapping#object"/> + <subjectIdentifier href="http://isidorus/rdf2tm_mapping/object"/> <name> <value>object</value> </name> Modified: trunk/src/xml/rdf/rdf_tools.lisp ============================================================================== --- trunk/src/xml/rdf/rdf_tools.lisp (original) +++ trunk/src/xml/rdf/rdf_tools.lisp Mon Aug 24 12:37:40 2009 @@ -33,8 +33,7 @@ *rdf-rest* *rdf2tm-scope-prefix*) (:import-from :xml-constants - *rdf_core_psis.xtm*) - (:import-from :xml-constants + *rdf_core_psis.xtm* *core_psis.xtm*) (:import-from :xml-tools get-attribute @@ -306,7 +305,6 @@ (when (and (string= property-ns *rdf-ns*) (string= property-name "li")) (set-_n-name owner-identifier property))) - ;(set-_n-name property _n-counter))) t) @@ -371,6 +369,7 @@ datatype)) (when (and (or nodeID resource) (> (length content) 0)) + ;(set-_n-name property _n-counter))) (error "~awhen ~a is set no content is allowed: ~a!" err-pref (cond @@ -428,7 +427,6 @@ function and sets all rdf:li properties as a tupple to the *_n-map* list." (let ((child-nodes (child-nodes-or-text node :trim t))) - ;(_n-counter 0)) (when (get-ns-attribute node "li") (dom:map-node-map #'(lambda(attr)

1 0

[isidorus-cvs] r116 - in trunk/src: unit_tests xml/rdf
by Lukas Giessmann 18 Aug '09

18 Aug '09

Author: lgiessmann Date: Tue Aug 18 13:16:21 2009 New Revision: 116 Log: rdf-importer: fixed a bug with parsing property nodes Modified: trunk/src/unit_tests/rdf_importer_test.lisp trunk/src/xml/rdf/importer.lisp trunk/src/xml/rdf/rdf_tools.lisp 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 Aug 18 13:16:21 2009 @@ -332,7 +332,6 @@ (dom:set-attribute-ns prop *rdf-ns* "unknown" "unknown") (is-true (rdf-importer::parse-property prop 0)) (dom:append-child prop text-node) - (signals error (rdf-importer::parse-property prop 0)) (dom:remove-child prop text-node) (is-true (rdf-importer::parse-property prop 0)) (dom:remove-attribute-ns prop *rdf-ns* "unknown") Modified: trunk/src/xml/rdf/importer.lisp ============================================================================== --- trunk/src/xml/rdf/importer.lisp (original) +++ trunk/src/xml/rdf/importer.lisp Tue Aug 18 13:16:21 2009 @@ -876,8 +876,8 @@ (error "~aliteral content not allowed here: ~a" err-pref content)) (loop for arc across content - do (import-arc arc tm-id start-revision :document-id document-id - :xml-base fn-xml-base :xml-lang fn-xml-lang)))) + collect (import-arc arc tm-id start-revision :document-id document-id + :xml-base fn-xml-base :xml-lang fn-xml-lang)))) (defun make-recursion-from-arc (arc tm-id start-revision Modified: trunk/src/xml/rdf/rdf_tools.lisp ============================================================================== --- trunk/src/xml/rdf/rdf_tools.lisp (original) +++ trunk/src/xml/rdf/rdf_tools.lisp Tue Aug 18 13:16:21 2009 @@ -359,24 +359,29 @@ (when (and nodeID resource) (error "~aondly one of rdf:nodeID and rdf:resource is allowed: (~a) (~a)!" err-pref nodeID resource)) - (when (and (or nodeID resource type) + (when (and (or nodeID resource type literals) datatype) (error "~aonly one of ~a and rdf:datatype (~a) is allowed!" err-pref (cond (nodeID (concatenate 'string "rdf:nodeID (" nodeID ")")) (resource (concatenate 'string "rdf:resource (" resource ")")) - (type (concatenate 'string "rdf:type (" type ")"))) + (type (concatenate 'string "rdf:type (" type ")")) + (literals literals)) datatype)) - (when (and (or type nodeID resource) + (when (and (or nodeID resource) (> (length content) 0)) (error "~awhen ~a is set no content is allowed: ~a!" err-pref (cond - (type (concatenate 'string "rdf:type (" type ")")) (nodeID (concatenate 'string "rdf:nodeID (" nodeID ")")) (resource (concatenate 'string "rdf:resource (" resource ")"))) content)) + (when (and type + (stringp content) + (> (length content) 0)) + (error "~awhen rdf:type is set no literal content is allowed: ~a!" + err-pref content)) (when (and (or type (and (string= node-name "type") (string= node-ns *rdf-ns*))

1 0

[isidorus-cvs] r115 - trunk/src/xml/rdf
by Lukas Giessmann 18 Aug '09

18 Aug '09

Author: lgiessmann Date: Tue Aug 18 09:50:24 2009 New Revision: 115 Log: rdf-mporter: moved all calls of the elephant-macro "ensure-transaction" to the two public and top layered functions "setup-rdf-module" and "rdf-importer" Modified: trunk/src/xml/rdf/importer.lisp trunk/src/xml/rdf/rdf_tools.lisp Modified: trunk/src/xml/rdf/importer.lisp ============================================================================== --- trunk/src/xml/rdf/importer.lisp (original) +++ trunk/src/xml/rdf/importer.lisp Tue Aug 18 09:50:24 2009 @@ -41,12 +41,13 @@ (unless elephant:*store-controller* (elephant:open-store (get-store-spec repository-path))) - (let ((rdf-dom - (dom:document-element (cxml:parse-file - (truename rdf-xml-path) - (cxml-dom:make-dom-builder))))) - (import-dom rdf-dom start-revision :tm-id tm-id :document-id document-id)) - (setf *_n-map* nil))) + (elephant:ensure-transaction (:txn-nosync t) + (let ((rdf-dom + (dom:document-element (cxml:parse-file + (truename rdf-xml-path) + (cxml-dom:make-dom-builder))))) + (import-dom rdf-dom start-revision :tm-id tm-id :document-id document-id)) + (setf *_n-map* nil)))) (defun init-rdf-module (&optional (revision (get-revision))) @@ -57,22 +58,16 @@ (let ((core-dom (cxml:parse-file *rdf_core_psis.xtm* (cxml-dom:make-dom-builder)))) - (loop for top-elem across - (xpath-child-elems-by-qname (dom:document-element core-dom) - *xtm2.0-ns* "topic") - do - (let - ((top - (from-topic-elem-to-stub top-elem revision - :xtm-id *rdf-core-xtm*))) - (add-to-topicmap xml-importer::tm top))))))) - - -(defun tm-id-p (tm-id fun-name) - "Checks the validity of the passed tm-id." - (unless (absolute-uri-p tm-id) - (error "From ~a(): you must provide a stable identifier (PSI-style) for this TM: ~a!" - fun-name tm-id))) + (elephant:ensure-transaction (:txn-nosync t) + (loop for top-elem across + (xpath-child-elems-by-qname (dom:document-element core-dom) + *xtm2.0-ns* "topic") + do + (let + ((top + (from-topic-elem-to-stub top-elem revision + :xtm-id *rdf-core-xtm*))) + (add-to-topicmap xml-importer::tm top)))))))) (defun import-dom (rdf-dom start-revision @@ -126,24 +121,23 @@ (super-classes (get-super-classes-of-node-content elem tm-id xml-base))) (with-tm (start-revision document-id tm-id) - (elephant:ensure-transaction (:txn-nosync t) - (let ((this - (make-topic-stub - about ID nodeID UUID start-revision xml-importer::tm - :document-id document-id))) - (make-literals this literals tm-id start-revision - :document-id document-id) - (make-associations this associations xml-importer::tm - start-revision :document-id document-id) - (make-types this types xml-importer::tm start-revision - :document-id document-id) - (make-super-classes this super-classes xml-importer::tm - start-revision :document-id document-id) - (make-recursion-from-node elem tm-id start-revision - :document-id document-id - :xml-base xml-base - :xml-lang xml-lang) - this))))))) + (let ((this + (make-topic-stub + about ID nodeID UUID start-revision xml-importer::tm + :document-id document-id))) + (make-literals this literals tm-id start-revision + :document-id document-id) + (make-associations this associations xml-importer::tm + start-revision :document-id document-id) + (make-types this types xml-importer::tm start-revision + :document-id document-id) + (make-super-classes this super-classes xml-importer::tm + start-revision :document-id document-id) + (make-recursion-from-node elem tm-id start-revision + :document-id document-id + :xml-base xml-base + :xml-lang xml-lang) + this)))))) (defun import-arc (elem tm-id start-revision @@ -360,21 +354,20 @@ (unless (or role-type-1 role-type-2) (error "~aone of the role types ~a ~a is missing!" err-pref *supertype-psi* *subtype-psi*)) - (elephant:ensure-transaction (:txn-nosync t) - (let ((a-roles (list (list :instance-of role-type-1 - :player super-top) - (list :instance-of role-type-2 - :player sub-top)))) - (when reifier-id - (make-reification reifier-id sub-top super-top - assoc-type start-revision tm - :document-id document-id)) - (add-to-topicmap - tm - (make-construct 'AssociationC - :start-revision start-revision - :instance-of assoc-type - :roles a-roles)))))) + (let ((a-roles (list (list :instance-of role-type-1 + :player super-top) + (list :instance-of role-type-2 + :player sub-top)))) + (when reifier-id + (make-reification reifier-id sub-top super-top + assoc-type start-revision tm + :document-id document-id)) + (add-to-topicmap + tm + (make-construct 'AssociationC + :start-revision start-revision + :instance-of assoc-type + :roles a-roles))))) (defun make-instance-of-association (instance-top type-top reifier-id @@ -399,21 +392,20 @@ (unless (or roletype-1 roletype-2) (error "~aone of the role types ~a ~a is missing!" err-pref *type-psi* *instance-psi*)) - (elephant:ensure-transaction (:txn-nosync t) - (let ((a-roles (list (list :instance-of roletype-1 - :player type-top) - (list :instance-of roletype-2 - :player instance-top)))) - (when reifier-id - (make-reification reifier-id instance-top type-top - assoc-type start-revision tm - :document-id document-id)) - (add-to-topicmap - tm - (make-construct 'AssociationC - :start-revision start-revision - :instance-of assoc-type - :roles a-roles)))))) + (let ((a-roles (list (list :instance-of roletype-1 + :player type-top) + (list :instance-of roletype-2 + :player instance-top)))) + (when reifier-id + (make-reification reifier-id instance-top type-top + assoc-type start-revision tm + :document-id document-id)) + (add-to-topicmap + tm + (make-construct 'AssociationC + :start-revision start-revision + :instance-of assoc-type + :roles a-roles))))) (defun make-topic-stub (about ID nodeId UUID start-revision @@ -438,20 +430,19 @@ inner-top)))) (if top top - (elephant:ensure-transaction (:txn-nosync t) - (let ((psi (when psi-uri - (make-instance 'PersistentIdC - :uri psi-uri - :start-revision start-revision)))) - (handler-case (add-to-topicmap - tm - (make-construct 'TopicC - :topicid topic-id - :psis (when psi (list psi)) - :xtm-id document-id - :start-revision start-revision)) - (Condition (err)(error "Creating topic ~a failed: ~a" - topic-id err))))))))) + (let ((psi (when psi-uri + (make-instance 'PersistentIdC + :uri psi-uri + :start-revision start-revision)))) + (handler-case (add-to-topicmap + tm + (make-construct 'TopicC + :topicid topic-id + :psis (when psi (list psi)) + :xtm-id document-id + :start-revision start-revision)) + (Condition (err)(error "Creating topic ~a failed: ~a" + topic-id err)))))))) (defun make-lang-topic (lang start-revision tm @@ -479,30 +470,29 @@ (player-id (getf association :topicid)) (player-psi (getf association :psi)) (ID (getf association :ID))) - (elephant:ensure-transaction (:txn-nosync t) - (let ((player-1 (make-topic-stub player-psi nil player-id nil - start-revision - tm :document-id document-id)) - (role-type-1 - (make-topic-stub *rdf2tm-object* nil nil nil - start-revision tm :document-id document-id)) - (role-type-2 - (make-topic-stub *rdf2tm-subject* nil nil nil - start-revision tm :document-id document-id)) - (type-top (make-topic-stub type nil nil nil start-revision - tm :document-id document-id))) - (let ((roles (list (list :instance-of role-type-1 - :player player-1) - (list :instance-of role-type-2 - :player top)))) - (when ID - (make-reification ID top player-1 type-top start-revision - tm :document-id document-id)) - (add-to-topicmap tm (make-construct 'AssociationC - :start-revision start-revision - :instance-of type-top - :roles roles))))))) - + (let ((player-1 (make-topic-stub player-psi nil player-id nil + start-revision + tm :document-id document-id)) + (role-type-1 + (make-topic-stub *rdf2tm-object* nil nil nil + start-revision tm :document-id document-id)) + (role-type-2 + (make-topic-stub *rdf2tm-subject* nil nil nil + start-revision tm :document-id document-id)) + (type-top (make-topic-stub type nil nil nil start-revision + tm :document-id document-id))) + (let ((roles (list (list :instance-of role-type-1 + :player player-1) + (list :instance-of role-type-2 + :player top)))) + (when ID + (make-reification ID top player-1 type-top start-revision + tm :document-id document-id)) + (add-to-topicmap tm (make-construct 'AssociationC + :start-revision start-revision + :instance-of type-top + :roles roles)))))) + (defun make-association-with-nodes (subject-topic object-topic associationtype-topic tm start-revision @@ -520,11 +510,10 @@ :player subject-topic) (list :instance-of role-type-2 :player object-topic)))) - (elephant:ensure-transaction (:txn-nosync t) - (add-to-topicmap tm (make-construct 'AssociationC - :start-revision start-revision - :instance-of associationtype-topic - :roles roles)))))) + (add-to-topicmap tm (make-construct 'AssociationC + :start-revision start-revision + :instance-of associationtype-topic + :roles roles))))) (defun make-reification (reifier-id subject object predicate start-revision tm @@ -545,24 +534,23 @@ tm :document-id document-id)) (statement (make-topic-stub *rdf-statement* nil nil nil start-revision tm :document-id document-id))) - (elephant:ensure-transaction (:txn-nosync t) - (make-instance-of-association reifier statement nil start-revision tm - :document-id document-id) - (make-association-with-nodes reifier subject subject-arc tm - start-revision :document-id document-id) - (make-association-with-nodes reifier predicate predicate-arc - tm start-revision :document-id document-id) - (if (typep object 'd:TopicC) - (make-association-with-nodes reifier object object-arc - tm start-revision - :document-id document-id) - (make-construct 'd:OccurrenceC - :start-revision start-revision - :topic reifier - :themes (themes object) - :instance-of (instance-of object) - :charvalue (charvalue object) - :datatype (datatype object)))))) + (make-instance-of-association reifier statement nil start-revision tm + :document-id document-id) + (make-association-with-nodes reifier subject subject-arc tm + start-revision :document-id document-id) + (make-association-with-nodes reifier predicate predicate-arc + tm start-revision :document-id document-id) + (if (typep object 'd:TopicC) + (make-association-with-nodes reifier object object-arc + tm start-revision + :document-id document-id) + (make-construct 'd:OccurrenceC + :start-revision start-revision + :topic reifier + :themes (themes object) + :instance-of (instance-of object) + :charvalue (charvalue object) + :datatype (datatype object))))) (defun make-occurrence (top literal start-revision tm-id @@ -577,26 +565,25 @@ (lang (getf literal :lang)) (datatype (getf literal :datatype)) (ID (getf literal :ID))) - (elephant:ensure-transaction (:txn-nosync t) - (let ((type-top (make-topic-stub type nil nil nil start-revision - xml-importer::tm - :document-id document-id)) - (lang-top (make-lang-topic lang start-revision - xml-importer::tm - :document-id document-id))) - (let ((occurrence - (make-construct 'OccurrenceC - :start-revision start-revision - :topic top - :themes (when lang-top - (list lang-top)) - :instance-of type-top - :charvalue value - :datatype datatype))) - (when ID - (make-reification ID top occurrence type-top start-revision - xml-importer::tm :document-id document-id)) - occurrence)))))) + (let ((type-top (make-topic-stub type nil nil nil start-revision + xml-importer::tm + :document-id document-id)) + (lang-top (make-lang-topic lang start-revision + xml-importer::tm + :document-id document-id))) + (let ((occurrence + (make-construct 'OccurrenceC + :start-revision start-revision + :topic top + :themes (when lang-top + (list lang-top)) + :instance-of type-top + :charvalue value + :datatype datatype))) + (when ID + (make-reification ID top occurrence type-top start-revision + xml-importer::tm :document-id document-id)) + occurrence))))) (defun get-literals-of-node-content (node tm-id xml-base xml-lang) Modified: trunk/src/xml/rdf/rdf_tools.lisp ============================================================================== --- trunk/src/xml/rdf/rdf_tools.lisp (original) +++ trunk/src/xml/rdf/rdf_tools.lisp Tue Aug 18 09:50:24 2009 @@ -459,4 +459,11 @@ (get-absolute-attribute elem tm-id fn-xml-base "datatype"))) (if datatype datatype - *xml-string*)))) \ No newline at end of file + *xml-string*)))) + + +(defun tm-id-p (tm-id fun-name) + "Checks the validity of the passed tm-id." + (unless (absolute-uri-p tm-id) + (error "From ~a(): you must provide a stable identifier (PSI-style) for this TM: ~a!" + fun-name tm-id))) \ No newline at end of file

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

isidorus-cvs