August 2009 - isidorus-cvs@common-lisp.net

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

31 Aug '09

Author: lgiessmann Date: Mon Aug 31 16:01:56 2009 New Revision: 127 Log: rdf-exporter: fixed a bug with exporting association which has to be mapped as sisidorus:Association 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 Mon Aug 31 16:01:56 2009 @@ -97,7 +97,7 @@ (d:find-item-by-revision top revision)) (if ,tm (union - (d:topics ,tm) (d:associations ,tm)) + (d:topics ,tm) (intersection (list-tm-associations) (d:associations ,tm))) (union (elephant:get-instances-by-class 'd:TopicC) (list-tm-associations)))))))

1 0

[isidorus-cvs] r126 - in trunk/src: . xml/rdf
by Lukas Giessmann 31 Aug '09

31 Aug '09

Author: lgiessmann Date: Mon Aug 31 12:20:06 2009 New Revision: 126 Log: rdf-importer: changed functions that collects resource-information, so properties which contains isidorus contructs are ignored and can be handled separately Modified: trunk/src/constants.lisp trunk/src/xml/rdf/importer.lisp trunk/src/xml/rdf/rdf_tools.lisp Modified: trunk/src/constants.lisp ============================================================================== --- trunk/src/constants.lisp (original) +++ trunk/src/constants.lisp Mon Aug 31 12:20:06 2009 @@ -50,7 +50,10 @@ :*tm2rdf-role-type-uri* :*tm2rdf-role-property* :*tm2rdf-association-type-uri* - :*tm2rdf-associaiton-property*)) + :*tm2rdf-associaiton-property* + :*tm2rdf-subjectIdentifier-property* + :*tm2rdf-itemIdentity-property* + :*tm2rdf-subjectLocator-property*)) (in-package :constants) @@ -135,3 +138,9 @@ (defparameter *tm2rdf-association-type-uri* (concatenate 'string *tm2rdf-ns* "Association")) (defparameter *tm2rdf-association-property* (concatenate 'string *tm2rdf-ns* "association")) + +(defparameter *tm2rdf-subjectIdentifier-property* (concatenate 'string *tm2rdf-ns* "subjectIdentifier")) + +(defparameter *tm2rdf-subjectLocator-property* (concatenate 'string *tm2rdf-ns* "subjectLocator")) + +(defparameter *tm2rdf-itemIdentity-property* (concatenate 'string *tm2rdf-ns* "itemIdentity")) Modified: trunk/src/xml/rdf/importer.lisp ============================================================================== --- trunk/src/xml/rdf/importer.lisp (original) +++ trunk/src/xml/rdf/importer.lisp Mon Aug 31 12:20:06 2009 @@ -110,6 +110,12 @@ (types (get-types-of-node elem tm-id :parent-xml-base xml-base)) (super-classes (get-super-classes-of-node-content elem tm-id xml-base))) + ;TODO: collect isidorus' subjectIdentifiers, itemIdentities, + ; subjectLocators, names and occurrences + ; add the collected constructs to the topic-stub + + ;TODO: collect associations and association roles and create the + ; corresponding constructs and stops the recusrion (with-tm (start-revision document-id tm-id) (let ((this (make-topic-stub @@ -176,6 +182,9 @@ (super-classes (get-super-classes-of-node-content elem tm-id xml-base))) + ;TODO: collect isidorus' subjectIdentifiers, itemIdentities, + ; subjectLocators, names and occurrences + ; add the collected constructs to the topic-stub (make-literals this literals tm-id start-revision :document-id document-id) (make-associations this associations xml-importer::tm @@ -580,7 +589,7 @@ "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-noode-content") - (let ((properties (child-nodes-or-text node :trim t)) + (let ((properties (non-isidorus-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))) (let ((literals @@ -605,8 +614,6 @@ (not (or prop-literals type)) (string/= parseType "Collection") (string/= parseType "Resource"))) - - collect (let ((content (child-nodes-or-text property)) (ID (get-absolute-attribute property tm-id fn-xml-base "ID")) @@ -651,8 +658,8 @@ :ID nil)) nil)) (content-types - (when (child-nodes-or-text node :trim t) - (loop for child across (child-nodes-or-text node :trim t) + (when (non-isidorus-child-nodes-or-text node :trim t) + (loop for child across (non-isidorus-child-nodes-or-text node :trim t) when (and (string= (dom:namespace-uri child) *rdf-ns*) (string= (get-node-name child) "type")) collect (let ((nodeID (get-ns-attribute child "nodeID")) @@ -766,7 +773,7 @@ "Returns a list of super-classes and IDs." (declare (dom:element node)) (tm-id-p tm-id "get-super-classes-of-node-content") - (let ((content (child-nodes-or-text node :trim t)) + (let ((content (non-isidorus-child-nodes-or-text node :trim t)) (fn-xml-base (get-xml-base node :old-base xml-base))) (when content (loop for property across content @@ -799,7 +806,7 @@ (defun get-associations-of-node-content (node tm-id xml-base) "Returns a list of associations with a type, value and ID member." (declare (dom:element node)) - (let ((properties (child-nodes-or-text node :trim t)) + (let ((properties (non-isidorus-child-nodes-or-text node :trim t)) (fn-xml-base (get-xml-base node :old-base xml-base))) (loop for property across properties when (let ((prop-name (get-node-name property)) @@ -859,7 +866,7 @@ "Calls the next function that handles all DOM child elements of the passed element as arcs." (declare (dom:element node)) - (let ((content (child-nodes-or-text node :trim t)) + (let ((content (non-isidorus-child-nodes-or-text node :trim t)) (err-pref "From make-recursion-from-node(): ") (fn-xml-base (get-xml-base node :old-base xml-base)) (fn-xml-lang (get-xml-lang node :old-lang xml-lang))) @@ -878,7 +885,7 @@ (declare (dom:element arc)) (let ((fn-xml-base (get-xml-base arc :old-base xml-base)) (fn-xml-lang (get-xml-lang arc :old-lang xml-lang)) - (content (child-nodes-or-text arc)) + (content (non-isidorus-child-nodes-or-text arc)) (parseType (get-ns-attribute arc "parseType"))) (let ((datatype (get-absolute-attribute arc tm-id xml-base "datatype")) (type (get-absolute-attribute arc tm-id xml-base "type")) 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 31 12:20:06 2009 @@ -42,7 +42,10 @@ *tm2rdf-role-type-uri* *tm2rdf-role-property* *tm2rdf-association-type-uri* - *tm2rdf-association-property*) + *tm2rdf-association-property* + *tm2rdf-subjectIdentifier-property* + *tm2rdf-itemIdentity-property* + *tm2rdf-subjectLocator-property*) (:import-from :xml-constants *rdf_core_psis.xtm* *core_psis.xtm*) @@ -662,4 +665,26 @@ (when (and (= (length content) 1) (not (stringp content))) (type-p (elt content 0) type tm-id - :parent-xml-base xml-base)))))))))) \ No newline at end of file + :parent-xml-base xml-base)))))))))) + + +(defun non-isidorus-child-nodes-or-text (elem &key (trim nil)) + "Returns a list of node elements that are no isidorus properties, e.g. + isidorus:name, string-content or nil." + (let ((content (child-nodes-or-text elem :trim trim))) + (if (or (not content) + (stringp content)) + content + (remove-if #'(lambda(x) + (let ((x-uri (if (dom:namespace-uri x) + (concatenate-uri (dom:namespace-uri x) + (get-node-name x)) + (get-node-name x)))) + (or (string= x-uri *tm2rdf-name-property*) + (string= x-uri *tm2rdf-variant-property*) + (string= x-uri *tm2rdf-occurrence-property*) + (string= x-uri *tm2rdf-role-property*) + (string= x-uri *tm2rdf-subjectIdentifier-property*) + (string= x-uri *tm2rdf-itemIdentity-property*) + (string= x-uri *tm2rdf-subjectLocator-property*)))) + content)))) \ No newline at end of file

1 0

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

31 Aug '09

Author: lgiessmann Date: Mon Aug 31 11:30:16 2009 New Revision: 125 Log: rdf-importer: added some helper functions to be able to recognize constructs that were imported by isidorus, e.g. isidorus:name, etc. Modified: trunk/src/constants.lisp trunk/src/unit_tests/rdf_importer_test.lisp trunk/src/xml/rdf/importer.lisp trunk/src/xml/rdf/rdf_tools.lisp Modified: trunk/src/constants.lisp ============================================================================== --- trunk/src/constants.lisp (original) +++ trunk/src/constants.lisp Mon Aug 31 11:30:16 2009 @@ -39,7 +39,19 @@ :*rdf2tm-object* :*rdf2tm-subject* :*rdf2tm-scope-prefix* - :*tm2rdf-ns*)) + :*tm2rdf-ns* + :*tm2rdf-topic-type-uri* + :*tm2rdf-name-type-uri* + :*tm2rdf-name-property* + :*tm2rdf-variant-type-uri* + :*tm2rdf-variant-property* + :*tm2rdf-occurrence-type-uri* + :*tm2rdf-occurrence-property* + :*tm2rdf-role-type-uri* + :*tm2rdf-role-property* + :*tm2rdf-association-type-uri* + :*tm2rdf-associaiton-property*)) + (in-package :constants) (defparameter *xtm2.0-ns* "http://www.topicmaps.org/xtm/") @@ -80,24 +92,46 @@ (defparameter *rdf2tm-ns* "http://isidorus/rdf2tm_mapping/") -(defparameter *rdf-statement* "http://www.w3.org/1999/02/22-rdf-syntax-ns#Statement") +(defparameter *rdf-statement* (concatenate 'string *rdf-ns* "Statement")) -(defparameter *rdf-object* "http://www.w3.org/1999/02/22-rdf-syntax-ns#object") +(defparameter *rdf-object* (concatenate 'string *rdf-ns* "object")) -(defparameter *rdf-subject* "http://www.w3.org/1999/02/22-rdf-syntax-ns#subject") +(defparameter *rdf-subject* (concatenate 'string *rdf-ns* "subject")) -(defparameter *rdf-predicate* "http://www.w3.org/1999/02/22-rdf-syntax-ns#predicate") +(defparameter *rdf-predicate* (concatenate 'string *rdf-ns* "predicate")) -(defparameter *rdf-nil* "http://www.w3.org/1999/02/22-rdf-syntax-ns#nil") +(defparameter *rdf-nil* (concatenate 'string *rdf-ns* "nil")) -(defparameter *rdf-first* "http://www.w3.org/1999/02/22-rdf-syntax-ns#first") +(defparameter *rdf-first* (concatenate 'string *rdf-ns* "first")) -(defparameter *rdf-rest* "http://www.w3.org/1999/02/22-rdf-syntax-ns#rest") +(defparameter *rdf-rest* (concatenate 'string *rdf-ns* "rest")) -(defparameter *rdf2tm-object* "http://isidorus/rdf2tm_mapping/object") +(defparameter *rdf2tm-object* (concatenate 'string *rdf2tm-ns* "object")) -(defparameter *rdf2tm-subject* "http://isidorus/rdf2tm_mapping/subject") +(defparameter *rdf2tm-subject* (concatenate 'string *rdf2tm-ns* "subject")) -(defparameter *rdf2tm-scope-prefix* "http://isidorus/rdf2tm_mapping/scope/") +(defparameter *rdf2tm-scope-prefix* (concatenate 'string *rdf2tm-ns* "scope/")) -(defparameter *tm2rdf-ns* "http://isidorus/tm2rdf_mapping/") \ No newline at end of file +(defparameter *tm2rdf-ns* "http://isidorus/tm2rdf_mapping/") + +(defparameter *tm2rdf-topic-type-uri* (concatenate 'string *tm2rdf-ns* "Topic")) + +(defparameter *tm2rdf-name-type-uri* (concatenate 'string *tm2rdf-ns* "Name")) + +(defparameter *tm2rdf-name-property* (concatenate 'string *tm2rdf-ns* "name")) + +(defparameter *tm2rdf-variant-type-uri* (concatenate 'string *tm2rdf-ns* "Variant")) + +(defparameter *tm2rdf-variant-property* (concatenate 'string *tm2rdf-ns* "variant")) + +(defparameter *tm2rdf-occurrence-type-uri* (concatenate 'string *tm2rdf-ns* "Occurrence")) + +(defparameter *tm2rdf-occurrence-property* (concatenate 'string *tm2rdf-ns* "occurrence")) + +(defparameter *tm2rdf-role-type-uri* (concatenate 'string *tm2rdf-ns* "Role")) + +(defparameter *tm2rdf-role-property* (concatenate 'string *tm2rdf-ns* "role")) + +(defparameter *tm2rdf-association-type-uri* (concatenate 'string *tm2rdf-ns* "Association")) + +(defparameter *tm2rdf-association-property* (concatenate 'string *tm2rdf-ns* "association")) 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 31 11:30:16 2009 @@ -18,6 +18,7 @@ *rdf-ns* *rdfs-ns* *rdf2tm-ns* + *tm2rdf-ns* *xml-ns* *xml-string* *instance-psi* @@ -32,7 +33,13 @@ *rdf-subject* *rdf-object* *rdf-predicate* - *rdf-statement*) + *rdf-statement* + *tm2rdf-topic-type-uri* + *tm2rdf-name-type-uri* + *tm2rdf-variant-type-uri* + *tm2rdf-occurrence-type-uri* + *tm2rdf-role-type-uri* + *tm2rdf-association-type-uri*) (:import-from :xml-tools xpath-child-elems-by-qname xpath-single-child-elem-by-qname @@ -59,7 +66,10 @@ :test-poems-rdf-topics :test-empty-collection :test-collection - :test-xml-base)) + :test-xml-base + :test-get-type-psis + :test-get-all-type-psis + :test-isidorus-type-p)) (declaim (optimize (debug 3) (speed 0) (safety 3) (space 0) (compilation-speed 0))) @@ -3054,7 +3064,200 @@ "http://base-3/test"))))))) +(test test-get-type-psis + "Tests the function get-type-psis." + (let ((tm-id "http://test-tm/") + (doc-1 + (concatenate 'string "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" " + "xmlns:sw=\"http://test/arcs/\">" + " <sw:Node rdf:about=\"http://sw/node\"" + " rdf:type=\"http://sw/Node-1\">" + " <sw:type rdf:resource=\"anyResource\"/>" + " <rdf:type rdf:resource=\"Node-2\"/>" + " <rdf:type rdf:resource=\"http://sw/Node-3\"/>" + " <rdf:type rdf:nodeID=\"anyType\"/>" + " </sw:Node>" + + " <rdf:Description rdf:about=\"http://sw/emtpy\"/>" + "</rdf:RDF>"))) + (let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder)))) + (let ((rdf-node (elt (dom:child-nodes dom-1) 0))) + (is (= (length (rdf-importer::child-nodes-or-text rdf-node)) 2)) + (let ((resource-1 + (elt (rdf-importer::child-nodes-or-text rdf-node) 0)) + (resource-2 + (elt (rdf-importer::child-nodes-or-text rdf-node) 1)) + (types (list "http://test/arcs/Node" "http://sw/Node-1" + "http://xml-base/Node-2" "http://sw/Node-3")) + (types-2 (list "http://test/arcs/Node" "http://sw/Node-1" + (concatenate 'string tm-id "Node-2") + "http://sw/Node-3"))) + (is-true resource-1) + (is-true resource-2) + (is (= (length + (intersection + types + (rdf-importer::get-type-psis + resource-1 tm-id + :parent-xml-base "http://xml-base/") + :test #'string=)) + (length types))) + (is (= (length + (intersection + types-2 + (rdf-importer::get-type-psis resource-1 tm-id) + :test #'string=)) + (length types-2))) + (is-false (rdf-importer::get-type-psis + resource-2 tm-id + :parent-xml-base "http://xml-base/"))))))) + + +(test test-get-all-type-psis + "Tests the functions get-all-type-psis, get-type-psis-across-dom and + get-type-psis." + (let ((tm-id "http://test-tm/") + (doc-1 + (concatenate 'string "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" " + "xmlns:sw=\"http://test/arcs/\">" + " <rdf:Description rdf:nodeID=\"anyNode\">" + " <rdf:type rdf:resource=\"http://type-1\"/>" + " <sw:arc>" + " <rdf:Description rdf:nodeID=\"anyNode\" " + " rdf:type=\"http://type-2\"/>" + " </sw:arc>" + " </rdf:Description>" + + " <rdf:Description rdf:nodeID=\"anotherNode\">" + " <rdf:type rdf:resource=\"http://type-3\"/>" + " </rdf:Description>" + + " <sw:NodeType rdf:nodeID=\"anyNode\"/>" + + " <rdf:Description rdf:nodeID=\"anyNode\" " + " rdf:datatype=\"anyDatatype\">" + " <rdf:type rdf:resource=\"http://type-7\"/>" + " </rdf:Description>" + + " <rdf:Description rdf:about=\"http://a-node\">" + " <sw:arc>" + " <rdf:Description rdf:about=\"http://b-node\">" + " <rdf:type rdf:resource=\"http://type-5\"/>" + " <rdf:arc>" + " <rdf:Description rdf:nodeID=\"anyNode\">" + " <rdf:type rdf:resource=\"http://type-5\"/>" + " <rdf:type rdf:resource=\"http://type-6\"/>" + " </rdf:Description>" + " </rdf:arc>" + " </rdf:Description>" + " </sw:arc>" + " </rdf:Description>" + "</rdf:RDF>"))) + (let ((root (elt (dom:child-nodes (cxml:parse doc-1 + (cxml-dom:make-dom-builder))) + 0))) + (is (= (length (rdf-importer::child-nodes-or-text root)) 5)) + (let ((any-node-1 (elt (rdf-importer::child-nodes-or-text root) 0)) + (another-node (elt (rdf-importer::child-nodes-or-text root) 1)) + (fn-types (list "http://type-1" "http://type-2" + "http://test/arcs/NodeType" "http://type-5" + "http://type-6")) + (any-node-4 (elt (rdf-importer::child-nodes-or-text root) 3))) + (let ((types-1 (rdf-importer::get-all-type-psis any-node-1 tm-id)) + (types-4 (rdf-importer::get-all-type-psis any-node-4 tm-id)) + (types-another-node (rdf-importer::get-all-type-psis + another-node tm-id))) + (is (= (length (intersection fn-types types-1 :test #'string=)) + (length fn-types))) + (is (= (length types-another-node) 1)) + (is (string= "http://type-3" + (first types-another-node))) + (is (= (length (intersection fn-types types-4 :test #'string=)) + (length fn-types)))))))) + + +(test test-isidorus-type-p + "Tests the function isidorus-type-p." + (let ((tm-id "http://test-tm/") + (doc-1 + (concatenate 'string "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" " + "xmlns:sw=\"http://test/arcs/\" " + "xmlns:isi=\"" *tm2rdf-ns* "\">" + " <isi:Topic rdf:about=\"http://node-1\">" + " <isi:name>" + " <rdf:Description rdf:nodeID=\"name-id\"/>" + " </isi:name>" + " <isi:occurrence rdf:nodeID=\"occurrence-id\"/>" + " <isi:occurrence>" + " <rdf:Description>" + " <rdf:type rdf:resource=\"" + *tm2rdf-occurrence-type-uri* "\"/>" + " </rdf:Description>" + " </isi:occurrence>" + " </isi:Topic>" + + " <rdf:Description rdf:nodeID=\"name-id\">" + " <rdf:type rdf:resource=\"" *tm2rdf-name-type-uri*"\"/>" + " <isi:variant>" + " <isi:Variant rdf:nodeID=\"variant-id\"/>" + " </isi:variant>" + " </rdf:Description>" + + " <isi:Occurrence rdf:nodeID=\"occurrence-id\"/>" + + " <rdf:Description rdf:nodeID=\"association-id\">" + " <rdf:type rdf:resource=\"" + *tm2rdf-association-type-uri* "\"/>" + " <isi:role>" + " <isi:Role rdf:nodeID=\"role-id\"/>" + " </isi:role>" + " </rdf:Description>" + "</rdf:RDF>"))) + (let ((root (elt (dom:child-nodes (cxml:parse doc-1 + (cxml-dom:make-dom-builder))) + 0))) + (is (= (length (rdf-importer::child-nodes-or-text root)) 4)) + (let ((topic-node (elt (rdf-importer::child-nodes-or-text root) 0)) + (association-node (elt (rdf-importer::child-nodes-or-text root) 3))) + (let ((topic-name (elt (rdf-importer::child-nodes-or-text topic-node) + 0)) + (topic-occurrence-1 (elt (rdf-importer::child-nodes-or-text + topic-node) + 1)) + (topic-occurrence-2 (elt (rdf-importer::child-nodes-or-text + topic-node) + 2)) + (association-role (elt (rdf-importer::child-nodes-or-text + association-node) + 1)) + (name-variant (elt (rdf-importer::child-nodes-or-text + (elt (rdf-importer::child-nodes-or-text root) + 1)) + 1))) + (is-true (rdf-importer::isidorus-type-p topic-node tm-id + 'rdf-importer::topic)) + (is-true (rdf-importer::isidorus-type-p association-node tm-id + 'rdf-importer::association)) + (is-true (rdf-importer::isidorus-type-p topic-name tm-id + 'rdf-importer::name)) + (is-true (rdf-importer::isidorus-type-p name-variant tm-id + 'rdf-importer::variant)) + (is-true (rdf-importer::isidorus-type-p topic-occurrence-1 tm-id + 'rdf-importer::occurrence)) + (is-true (rdf-importer::isidorus-type-p topic-occurrence-2 tm-id + 'rdf-importer::occurrence)) + (is-true (rdf-importer::isidorus-type-p association-role tm-id + 'rdf-importer::role)) + (is-false (rdf-importer::isidorus-type-p + (elt (rdf-importer::child-nodes-or-text root) 1) tm-id + 'rdf-importer::name)) + (is-false (rdf-importer::isidorus-type-p + (elt (rdf-importer::child-nodes-or-text root) 2) tm-id + 'rdf-importer::occurrence))))))) + + (defun run-rdf-importer-tests() + "Runs all defined tests." (when elephant:*store-controller* (elephant:close-store)) (it.bese.fiveam:run! 'test-get-literals-of-node) @@ -3075,4 +3278,7 @@ (it.bese.fiveam:run! 'test-poems-rdf-topics) (it.bese.fiveam:run! 'test-empty-collection) (it.bese.fiveam:run! 'test-collection) - (it.bese.fiveam:run! 'test-xml-base)) \ No newline at end of file + (it.bese.fiveam:run! 'test-xml-base) + (it.bese.fiveam:run! 'test-get-type-psis) + (it.bese.fiveam:run! 'test-get-all-type-psis) + (it.bese.fiveam:run! 'test-isidorus-type-p)) \ 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 31 11:30:16 2009 @@ -96,8 +96,7 @@ (format t ">> import-node: ~a <<~%" (dom:node-name elem)) ;TODO: remove (tm-id-p tm-id "import-node") (parse-node elem) - (let ((fn-xml-base (get-xml-base elem :old-base xml-base)) - (fn-xml-lang (get-xml-lang elem :old-lang xml-lang))) + (let ((fn-xml-lang (get-xml-lang elem :old-lang xml-lang))) (let ((about (get-absolute-attribute elem tm-id xml-base "about")) (nodeID (get-ns-attribute elem "nodeID")) (ID (get-absolute-attribute elem tm-id xml-base "ID")) @@ -108,16 +107,7 @@ (get-literals-of-node-content elem tm-id xml-base fn-xml-lang))) (associations (get-associations-of-node-content elem tm-id xml-base)) - (types (remove-if - #'null - (append (list - (unless (string= (get-type-of-node-name elem) - (concatenate 'string *rdf-ns* - "Description")) - (list :topicid (get-type-of-node-name elem) - :psi (get-type-of-node-name elem) - :ID nil))) - (get-types-of-node-content elem tm-id fn-xml-base)))) + (types (get-types-of-node elem tm-id :parent-xml-base xml-base)) (super-classes (get-super-classes-of-node-content elem tm-id xml-base))) (with-tm (start-revision document-id tm-id) 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 31 11:30:16 2009 @@ -31,7 +31,18 @@ *rdf-nil* *rdf-first* *rdf-rest* - *rdf2tm-scope-prefix*) + *rdf2tm-scope-prefix* + *tm2rdf-topic-type-uri* + *tm2rdf-name-type-uri* + *tm2rdf-name-property* + *tm2rdf-variant-type-uri* + *tm2rdf-variant-property* + *tm2rdf-occurrence-type-uri* + *tm2rdf-occurrence-property* + *tm2rdf-role-type-uri* + *tm2rdf-role-property* + *tm2rdf-association-type-uri* + *tm2rdf-association-property*) (:import-from :xml-constants *rdf_core_psis.xtm* *core_psis.xtm*) @@ -369,8 +380,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!" + (error "~awhen ~a is set no content is allowed: ~a!" err-pref (cond (nodeID (concatenate 'string "rdf:nodeID (" nodeID ")")) @@ -469,4 +479,187 @@ "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 + fun-name tm-id))) + + +(defun get-types-of-node (elem tm-id &key (parent-xml-base nil)) + "Returns a plist of all node's types of the form + (:topicid <string> :psi <string> :ID <string>)." + (let ((xml-base (get-xml-base elem :old-base parent-xml-base))) + (remove-if + #'null + (append (unless (string= (get-type-of-node-name elem) + (concatenate 'string *rdf-ns* + "Description")) + (list + (list :topicid (get-type-of-node-name elem) + :psi (get-type-of-node-name elem) + :ID nil))) + (get-types-of-node-content elem tm-id xml-base))))) + + +(defun get-type-psis (elem tm-id + &key (parent-xml-base nil)) + "Returns a list of type-uris of the passed node." + (let ((types (get-types-of-node elem tm-id + :parent-xml-base parent-xml-base))) + (remove-if #'null + (map 'list #'(lambda(x) + (getf x :psi)) + types)))) + + +(defun get-all-type-psis-of-id (nodeID tm-id document) + "Returns a list of type-uris for resources identified by the given + nodeID by analysing the complete XML-DOM." + (let ((root (elt (dom:child-nodes document) 0))) + (remove-duplicates + (remove-if #'null + (if (and (string= (dom:namespace-uri root) *rdf-ns*) + (string= (get-node-name root)"RDF")) + (loop for node across (child-nodes-or-text root) + append (get-all-type-psis-across-dom + root tm-id :resource-id nodeID)) + (get-all-type-psis-across-dom + root tm-id :resource-id nodeID))) + :test #'string=))) + + +(defun get-all-type-psis (elem tm-id &key (parent-xml-base nil)) + "Returns a list of type-uris for the element by analysing the complete + XML-DOM." + (let ((xml-base (get-xml-base elem :old-base parent-xml-base))) + (let ((root (elt (dom:child-nodes (dom:owner-document elem)) 0)) + (nodeID (get-ns-attribute elem "nodeID")) + (about (get-absolute-attribute elem tm-id xml-base "about"))) + (remove-duplicates + (remove-if #'null + (if (or nodeID about) + (if (and (string= (dom:namespace-uri root) *rdf-ns*) + (string= (get-node-name root) "RDF")) + (loop for node across (child-nodes-or-text root) + append (get-all-type-psis-across-dom + root tm-id :resource-uri about + :resource-id nodeID)) + (get-all-type-psis-across-dom + root tm-id :resource-uri about + :resource-id nodeID)) + (get-type-psis elem tm-id :parent-xml-base parent-xml-base))) + :test #'string=)))) + + +(defun get-all-type-psis-across-dom (elem tm-id &key (parent-xml-base nil) + (resource-uri nil) (resource-id nil) + (types nil)) + "Returns a list of type PSI strings collected over the complete XML-DOM + corresponding to the passed id's or uri." + (when (or resource-uri resource-id) + (let ((xml-base (get-xml-base elem :old-base parent-xml-base))) + (let ((datatype (when (get-ns-attribute elem "datatype") + t)) + (parseType (when (get-ns-attribute elem "parseType") + (string= (get-ns-attribute elem "parseType") + "Literal")))) + (if (or datatype parseType) + types + (let ((nodeID (get-ns-attribute elem "nodeID")) + (about (get-absolute-attribute elem tm-id xml-base "about"))) + (let ((fn-types + (append types + (when (or (and about resource-uri + (string= about resource-uri)) + (and nodeID resource-id + (string= nodeID resource-id))) + (get-type-psis elem tm-id + :parent-xml-base xml-base)))) + (content (child-nodes-or-text elem :trim t))) + (if (or (stringp content) + (not content)) + fn-types + (loop for child-node across content + append (get-all-type-psis-across-dom + child-node tm-id :parent-xml-base xml-base + :resource-uri resource-uri + :resource-id resource-id + :types fn-types)))))))))) + + +(defun type-p (elem type-uri tm-id &key (parent-xml-base nil)) + "Returns t if the type-uri is a type of elem." + (declare (string tm-id type-uri)) + (declare (dom:element elem)) + (tm-id-p tm-id "type-p") + (find type-uri (get-all-type-psis elem tm-id + :parent-xml-base parent-xml-base) + :test #'string=)) + + +(defun type-of-id-p (node-id type-uri tm-id document) + "Returns t if type-uri is a type of the passed node-id." + (declare (string node-id type-uri tm-id)) + (declare (dom:document document)) + (tm-id-p tm-id "type-of-ndoe-id-p") + (find type-uri (get-all-type-psis-of-id node-id tm-id document) + :test #'string=)) + + +(defun property-name-of-node-p (elem property-name-uri) + "Returns t if the elements tag-name and namespace are equal + to the given uri." + (declare (dom:element elem)) + (declare (string property-name-uri)) + (when property-name-uri + (let ((uri (concatenate-uri (dom:namespace-uri elem) + (get-node-name elem)))) + (string= uri property-name-uri)))) + + +(defun isidorus-type-p (property-elem-or-node-elem tm-id what + &key(parent-xml-base nil)) + "Returns t if the node elem is of the type isidorus:<Type> and is + contained in a porperty isidorus:<type>." + (declare (dom:element property-elem-or-node-elem)) + (declare (symbol what)) + (tm-id-p tm-id "isidorus-type-p") + (let ((xml-base (get-xml-base property-elem-or-node-elem + :old-base parent-xml-base)) + (type-and-property (cond + ((eql what 'name) + (list :type *tm2rdf-name-type-uri* + :property *tm2rdf-name-property*)) + ((eql what 'variant) + (list :type *tm2rdf-variant-type-uri* + :property *tm2rdf-variant-property*)) + ((eql what 'occurrence) + (list :type *tm2rdf-occurrence-type-uri* + :property *tm2rdf-occurrence-property*)) + ((eql what 'role) + (list :type *tm2rdf-role-type-uri* + :property *tm2rdf-role-property*)) + ((eql what 'topic) + (list :type *tm2rdf-topic-type-uri*)) + ((eql what 'association) + (list :type + *tm2rdf-association-type-uri*))))) + (when type-and-property + (let ((type (getf type-and-property :type)) + (property (getf type-and-property :property)) + (nodeID (get-ns-attribute property-elem-or-node-elem "nodeID")) + (document (dom:owner-document property-elem-or-node-elem)) + (elem-uri (concatenate-uri + (dom:namespace-uri + property-elem-or-node-elem) + (get-node-name property-elem-or-node-elem)))) + (if (or (string= type *tm2rdf-topic-type-uri*) + (string= type *tm2rdf-association-type-uri*)) + (type-p property-elem-or-node-elem type tm-id + :parent-xml-base parent-xml-base) + (when (string= elem-uri property) + (if nodeID + (type-of-id-p nodeId type tm-id document) + (let ((content (child-nodes-or-text property-elem-or-node-elem + :trim t))) + (when (and (= (length content) 1) + (not (stringp content))) + (type-p (elt content 0) type tm-id + :parent-xml-base xml-base)))))))))) \ No newline at end of file

1 0

[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