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
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
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
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
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
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
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
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
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
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/">
<!-- this file contains constructs that are originally defined as TM and
- RDF, so certain constructs are not consistent because of test cases -->
+ 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>
- <!-- the rdf:li elements are contained as a collection, to test the export
- of collections -->
+ <!-- === the rdf:li elements are contained as a collection, to test the
+ export of collections =============================================== -->
<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
+
+ <!-- === tests some TM associations that owns mor than two roles ========= -->
+ <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
24 Aug '09
Author: lgiessmann
Date: Mon Aug 24 12:37:40 2009
New Revision: 117
Log:
rdf-exporter: implemented a part of the rdf-exporter. currently associations, that do not represent type-instance or supertype-subtype associations are not exported; unit tests are not implemented at the moment, there is just a test file which can be xported "poems_light.xtm"
Added:
trunk/src/unit_tests/poems_light.xtm
Modified:
trunk/src/constants.lisp
trunk/src/isidorus.asd
trunk/src/model/datamodel.lisp
trunk/src/unit_tests/poems.rdf
trunk/src/unit_tests/poems_light.rdf
trunk/src/unit_tests/rdf_importer_test.lisp
trunk/src/xml/rdf/exporter.lisp
trunk/src/xml/rdf/importer.lisp
trunk/src/xml/rdf/rdf_core_psis.xtm
trunk/src/xml/rdf/rdf_tools.lisp
Modified: trunk/src/constants.lisp
==============================================================================
--- trunk/src/constants.lisp (original)
+++ trunk/src/constants.lisp Mon Aug 24 12:37:40 2009
@@ -27,6 +27,7 @@
:*xml-ns*
:*xmlns-ns*
:*xml-string*
+ :*xml-uri*
:*rdf2tm-ns*
:*rdf-statement*
:*rdf-object*
@@ -37,7 +38,8 @@
:*rdf-rest*
:*rdf2tm-object*
:*rdf2tm-subject*
- :*rdf2tm-scope-prefix*))
+ :*rdf2tm-scope-prefix*
+ :*tm2rdf-ns*))
(in-package :constants)
(defparameter *xtm2.0-ns* "http://www.topicmaps.org/xtm/")
@@ -74,7 +76,9 @@
(defparameter *xml-string* "http://www.w3.org/2001/XMLSchema#string")
-(defparameter *rdf2tm-ns* "http://isidorus/rdf2tm_mapping#")
+(defparameter *xml-uri* "http://www.w3.org/2001/XMLSchema#anyURI")
+
+(defparameter *rdf2tm-ns* "http://isidorus/rdf2tm_mapping/")
(defparameter *rdf-statement* "http://www.w3.org/1999/02/22-rdf-syntax-ns#Statement")
@@ -90,8 +94,10 @@
(defparameter *rdf-rest* "http://www.w3.org/1999/02/22-rdf-syntax-ns#rest")
-(defparameter *rdf2tm-object* "http://isidorus/rdf2tm_mapping#object")
+(defparameter *rdf2tm-object* "http://isidorus/rdf2tm_mapping/object")
+
+(defparameter *rdf2tm-subject* "http://isidorus/rdf2tm_mapping/subject")
-(defparameter *rdf2tm-subject* "http://isidorus/rdf2tm_mapping#subject")
+(defparameter *rdf2tm-scope-prefix* "http://isidorus/rdf2tm_mapping/scope/")
-(defparameter *rdf2tm-scope-prefix* "http://isidorus/rdf2tm_mapping/scope#")
\ No newline at end of file
+(defparameter *tm2rdf-ns* "http://isidorus/tm2rdf_mapping/")
\ No newline at end of file
Modified: trunk/src/isidorus.asd
==============================================================================
--- trunk/src/isidorus.asd (original)
+++ trunk/src/isidorus.asd Mon Aug 24 12:37:40 2009
@@ -107,6 +107,7 @@
(:static-file "poems.xtm")
(:static-file "poems.rdf")
(:static-file "poems_light.rdf")
+ (:static-file "poems_light.xtm")
(:file "atom-conf")
(:file "unittests-constants"
:depends-on ("dangling_topicref.xtm"
Modified: trunk/src/model/datamodel.lisp
==============================================================================
--- trunk/src/model/datamodel.lisp (original)
+++ trunk/src/model/datamodel.lisp Mon Aug 24 12:37:40 2009
@@ -66,6 +66,7 @@
:item-identifiers
:item-identifiers-p
:list-instanceOf
+ :list-super-types
:locators
:locators-p
:make-construct
@@ -105,6 +106,8 @@
:*TM-REVISION*
:with-revision ;;macros
+
+ :string-starts-with ;;helpers
))
(declaim (optimize (debug 3) (safety 3) (speed 0) (space 0)))
@@ -647,7 +650,6 @@
(elephant:get-instances-by-value 'PersistentIdC 'uri (uri id))
(elephant:get-instances-by-value 'SubjectLocatorC 'uri (uri id)))))
1)
- ;(format t "cfdi: ~A --> ~A~%" construct (item-identifiers construct))
(error
(make-condition 'duplicate-identifier-error
:message (format nil "Duplicate Identifier ~a has been found" (uri id))
@@ -1174,6 +1176,33 @@
(player-in-roles topic))
(player-in-roles topic)))))
+
+(defgeneric list-super-types (topic &key tm)
+ (:documentation "Generate a list of all topics that this topic is an
+ subclass of, optionally filtered by a topic map"))
+
+
+(defmethod list-super-types ((topic TopicC) &key (tm nil))
+ (remove-if
+ #'null
+ (map 'list #'(lambda(x)
+ (when (loop for psi in (psis (instance-of x))
+ when (string= (uri psi) *subtype-psi*)
+ return t)
+ (loop for role in (roles (parent x))
+ when (not (eq role x))
+ return (player role))))
+ (if tm
+ (remove-if-not
+ (lambda (role)
+ (format t "player: ~a" (player role))
+ (format t "parent: ~a" (parent role))
+ (format t "topic: ~a~&" topic)
+ (in-topicmap tm (parent role)))
+ (player-in-roles topic))
+ (player-in-roles topic)))))
+
+
(defun string-starts-with (str prefix)
"Checks if string str starts with a given prefix"
(declare (string str prefix))
Modified: trunk/src/unit_tests/poems.rdf
==============================================================================
--- trunk/src/unit_tests/poems.rdf (original)
+++ trunk/src/unit_tests/poems.rdf Mon Aug 24 12:37:40 2009
@@ -248,8 +248,8 @@
<rdf:type rdf:resource="/types/Poem"/>
<arcs:dateRange>
<rdf:Description xml:base="http://does.not.exist">
- <arcs:start rdf:datatype="http://www.w3.org/2001/XMLSchema#date">1772</arcs:start>
- <arcs:end rdf:datatype="http://www.w3.org/2001/XMLSchema#date">1774</arcs:end>
+ <arcs:start rdf:datatype="http://www.w3.org/2001/XMLSchema#date">01.01.1772</arcs:start>
+ <arcs:end rdf:datatype="http://www.w3.org/2001/XMLSchema#date">31.12.1774</arcs:end>
</rdf:Description>
</arcs:dateRange>
<arcs:content rdf:parseType="Literal" xml:lang="de">
Modified: trunk/src/unit_tests/poems_light.rdf
==============================================================================
--- trunk/src/unit_tests/poems_light.rdf (original)
+++ trunk/src/unit_tests/poems_light.rdf Mon Aug 24 12:37:40 2009
@@ -73,119 +73,7 @@
<arcs:start rdf:datatype="#date">01.01.1797</arcs:start>
<arcs:end rdf:datatype="#date">31.12.1797</arcs:end>
</arcs:dateRange>
- <arcs:content xml:lang="de">
- <![CDATA[Hat der alte Hexenmeister
-sich doch einmal wegbegeben!
-Und nun sollen seine Geister
-auch nach meinem Willen leben.
-Seine Wort und Werke
-merkt ich und den Brauch,
-und mit Geistesstärke
-tu ich Wunder auch.
-
-Walle! walle
-Manche Strecke,
-daß, zum Zwecke,
-Wasser fließe
-und mit reichem, vollem Schwalle
-zu dem Bade sich ergieße.
-
-Und nun komm, du alter Besen!
-Nimm die schlechten Lumpenhüllen;
-bist schon lange Knecht gewesen:
-nun erfülle meinen Willen!
-Auf zwei Beinen stehe,
-oben sei ein Kopf,
-eile nun und gehe
-mit dem Wassertopf!
-
-Walle! walle
-manche Strecke,
-daß, zum Zwecke,
-Wasser fließe
-und mit reichem, vollem Schwalle
-zu dem Bade sich ergieße.
-
-Seht, er läuft zum Ufer nieder,
-Wahrlich! ist schon an dem Flusse,
-und mit Blitzesschnelle wieder
-ist er hier mit raschem Gusse.
-Schon zum zweiten Male!
-Wie das Becken schwillt!
-Wie sich jede Schale
-voll mit Wasser füllt!
-
-Stehe! stehe!
-denn wir haben
-deiner Gaben
-vollgemessen! -
-Ach, ich merk es! Wehe! wehe!
-Hab ich doch das Wort vergessen!
-
-Ach, das Wort, worauf am Ende
-er das wird, was er gewesen.
-Ach, er läuft und bringt behende!
-Wärst du doch der alte Besen!
-Immer neue Güsse
-bringt er schnell herein,
-Ach! und hundert Flüsse
-stürzen auf mich ein.
-
-Nein, nicht länger
-kann ichs lassen;
-will ihn fassen.
-Das ist Tücke!
-Ach! nun wird mir immer bänger!
-Welche Mine! welche Blicke!
-
-O du Ausgeburt der Hölle!
-Soll das ganze Haus ersaufen?
-Seh ich über jede Schwelle
-doch schon Wasserströme laufen.
-Ein verruchter Besen,
-der nicht hören will!
-Stock, der du gewesen,
-steh doch wieder still!
-
-Willst am Ende
-gar nicht lassen?
-Will dich fassen,
-will dich halten
-und das alte Holz behende
-mit dem scharfen Beile spalten.
-
-Seht da kommt er schleppend wieder!
-Wie ich mich nur auf dich werfe,
-gleich, o Kobold, liegst du nieder;
-krachend trifft die glatte Schärfe.
-Wahrlich, brav getroffen!
-Seht, er ist entzwei!
-Und nun kann ich hoffen,
-und ich atme frei!
-
-Wehe! wehe!
-Beide Teile
-stehn in Eile
-schon als Knechte
-völlig fertig in die Höhe!
-Helft mir, ach! ihr hohen Mächte!
-
-Und sie laufen! Naß und nässer
-wirds im Saal und auf den Stufen.
-Welch entsetzliches Gewässer!
-Herr und Meister! hör mich rufen! -
-Ach, da kommt der Meister!
-Herr, die Not ist groß!
-Die ich rief, die Geister
-werd ich nun nicht los.
-
-"In die Ecke,
-Besen, Besen!
-Seids gewesen.
-Denn als Geister
-ruft euch nur zu diesem Zwecke,
-erst hervor der alte Meister."]]>
- </arcs:content>
+ <arcs:content xml:lang="de"><![CDATA[Hat der alte Hexenmeister ...]]></arcs:content>
</types:Poem>
</rdf:li>
</rdf:Bag>
@@ -200,47 +88,7 @@
<arcs:start rdf:datatype="#date">01.01.1782</arcs:start>
<arcs:end rdf:datatype="#date">31.12.1782</arcs:end>
</arcs:dateRange>
- <arcs:content rdf:datatype="http://www.w3.org/2001/XMLSchema#string" xml:lang="de">
- <![CDATA[Wer reitet so spät durch Nacht und Wind?
-Es ist der Vater mit seinem Kind;
-Er hat den Knaben wohl in dem Arm,
-Er faßt ihn sicher, er hält ihn warm.
-
-Mein Sohn, was birgst du so bang dein Gesicht? -
-Siehst Vater, du den Erlkönig nicht?
-Den Erlenkönig mit Kron und Schweif? -
-Mein Sohn, es ist ein Nebelstreif. -
-
-"Du liebes Kind, komm, geh mit mir!
-Gar schöne Spiele spiel ich mit dir;
-Manch bunte Blumen sind an dem Strand,
-Meine Mutter hat manch gülden Gewand."
-
-Mein Vater, mein Vater, und hörest du nicht,
-Was Erlenkönig mir leise verspricht? -
-Sei ruhig, bleibe ruhig, mein Kind;
-In dürren Blättern säuselt der Wind. -
-
-"Willst, feiner Knabe, du mit mir gehn?
-Meine Töchter sollen dich warten schön;
-Meine Töchter führen den nächtlichen Reihn
-Und wiegen und tanzen und singen dich ein."
-
-Mein Vater, mein Vater, und siehst du nicht dort
-Erlkönigs Töchter am düstern Ort? -
-Mein Sohn, mein Sohn, ich seh es genau:
-Es scheinen die alten Weiden so grau. -
-
-"Ich liebe dich, mich reizt deine schöne Gestalt;
-Und bist du nicht willig, so brauch ich Gewalt."
-Mein Vater, mein Vater, jetzt faßt er mich an!
-Erlkönig hat mir ein Leids getan! -
-
-Dem Vater grauset's, er reitet geschwind,
-Er hält in den Armen das ächzende Kind,
-Erreicht den Hof mit Mühe und Not;
-In seinen Armen das Kind war tot.]]>
- </arcs:content>
+ <arcs:content rdf:datatype="http://www.w3.org/2001/XMLSchema#string" xml:lang="de">Wer reitet so spät durch Nacht und Wind? ...</arcs:content>
</types:Ballad>
</rdf:li>
<rdf:li>
@@ -248,76 +96,11 @@
<rdf:type rdf:resource="/types/Poem"/>
<arcs:dateRange>
<rdf:Description xml:base="http://does.not.exist">
- <arcs:start rdf:datatype="http://www.w3.org/2001/XMLSchema#date">1772</arcs:start>
- <arcs:end rdf:datatype="http://www.w3.org/2001/XMLSchema#date">1774</arcs:end>
+ <arcs:start rdf:datatype="http://www.w3.org/2001/XMLSchema#date">01.01.1772</arcs:start>
+ <arcs:end rdf:datatype="http://www.w3.org/2001/XMLSchema#date">31.12.1774</arcs:end>
</rdf:Description>
</arcs:dateRange>
- <arcs:content rdf:parseType="Literal" xml:lang="de">
- <![CDATA[Bedecke deinen Himmel, Zeus,
-Mit Wolkendunst!
-Und übe, Knaben gleich,
-Der Disteln köpft,
-An Eichen dich und Bergeshöh'n!
-Mußt mir meine Erde
-Doch lassen steh'n,
-Und meine Hütte,
-Die du nicht gebaut,
-Und meinen Herd,
-Um dessen Glut
-Du mich beneidest.
-
-Ich kenne nichts Ärmeres
-Unter der Sonn' als euch Götter!
-Ihr nähret kümmerlich
-Von Opfersteuern
-Und Gebetshauch
-Eure Majestät
-Und darbtet, wären
-Nicht Kinder und Bettler
-Hoffnungsvolle Toren.
-
-Da ich ein Kind war,
-Nicht wußte, wo aus, wo ein,
-Kehrt' ich mein verirrtes Auge
-Zur Sonne, als wenn drüber wär
-Ein Ohr zu hören meine Klage,
-Ein Herz wie meins,
-Sich des Bedrängten zu erbarmen.
-
-Wer half mir
-Wider der Titanen Übermut?
-Wer rettete vom Tode mich,
-Von Sklaverei?
-Hast du's nicht alles selbst vollendet,
-Heilig glühend Herz?
-Und glühtest, jung und gut,
-Betrogen, Rettungsdank
-Dem Schlafenden dadroben?
-
-Ich dich ehren? Wofür?
-Hast du die Schmerzen gelindert
-Je des Beladenen?
-Hast du die Tränen gestillet
-Je des Geängsteten?
-Hat nicht mich zum Manne geschmiedet
-Die allmächtige Zeit
-Und das ewige Schicksal,
-Meine Herren und deine?
-
-Wähntest du etwa,
-Ich sollte das Leben hassen,
-In Wüsten fliehn,
-Weil nicht alle Knabenmorgen-
-Blütenträume reiften?
-
-Hier sitz' ich, forme Menschen
-Nach meinem Bilde,
-Ein Geschlecht, das mir gleich sei,
-Zu leiden, weinen,
-Genießen und zu freuen sich,
-Und dein nicht zu achten,
-Wie ich!]]>
- </arcs:content>
+ <arcs:content rdf:parseType="Literal" xml:lang="de"><![CDATA[ Bedecke deinen Himmel, Zeus, ... ]]></arcs:content>
</rdf:Description>
</rdf:li>
</rdf:Description>
Added: trunk/src/unit_tests/poems_light.xtm
==============================================================================
--- (empty file)
+++ trunk/src/unit_tests/poems_light.xtm Mon Aug 24 12:37:40 2009
@@ -0,0 +1,578 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<tm:topicMap version="2.0" xmlns:tm="http://www.topicmaps.org/xtm/">
+ <!-- this file contains constructs that are originally defined as TM and
+ RDF, so certain constructs are not consistent because of test cases -->
+ <tm:topic id="goethe">
+ <tm:subjectIdentifier href="http://some.where/author/Goehte"/>
+ <tm:instanceOf><tm:topicRef href="#author"/></tm:instanceOf>
+ <tm:name>
+ <tm:type><tm:topicRef href="#firstName"/></tm:type>
+ <tm:value>Johann Wolfgang</tm:value>
+ </tm:name>
+ <tm:occurrence>
+ <tm:type><tm:topicRef href="#lastName"/></tm:type>
+ <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string">von Goethe</tm:resourceData>
+ </tm:occurrence>
+ </tm:topic>
+
+ <tm:topic id="UUID-born-event">
+ <tm:instanceOf href="#event"/>
+ <tm:occurrence>
+ <tm:type><tm:topicRef href="#date"/></tm:type>
+ <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#date">28.08.1749</tm:resourceData>
+ </tm:occurrence>
+ </tm:topic>
+
+ <tm:topic id="frankfurt_m">
+ <tm:subjectIdentifier href="http://some.where/metropolis/FrankfurtMain"/>
+ <tm:instanceOf><tm:topicRef href="#metropolis"/></tm:instanceOf>
+ <tm:occurrence>
+ <tm:type><tm:topicRef href="#population"/></tm:type>
+ <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#unsignedLong">659000</tm:resourceData>
+ </tm:occurrence>
+ <tm:occurrence>
+ <tm:type><tm:topicRef href="#fullName"/></tm:type>
+ <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string">Frankfurt am Main</tm:resourceData>
+ </tm:occurrence>
+ </tm:topic>
+
+ <tm:topic id="germany">
+ <tm:subjectIdentifier href="http://some.where/country/Germany"/>
+ <tm:instanceOf><tm:topicRef href="#country"/></tm:instanceOf>
+ <tm:occurrence>
+ <tm:type><tm:topicRef href="#nativeName"/></tm:type>
+ <tm:scope><tm:topicRef href="#de"/></tm:scope>
+ <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string">Deutschland</tm:resourceData>
+ </tm:occurrence>
+ <tm:occurrence>
+ <tm:type><tm:topicRef href="#population"/></tm:type>
+ <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#unsignedLong">82099232</tm:resourceData>
+ </tm:occurrence>
+ </tm:topic>
+
+ <tm:topic id="berlin">
+ <tm:subjectIdentifier href="http://some.where/metropolis/Berlin"/>
+ <tm:instanceOf><tm:topicRef href="#metropolis"/></tm:instanceOf>
+ <tm:occurrence>
+ <tm:type><tm:topicRef href="#population"/></tm:type>
+ <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#unsignedLong">3431473</tm:resourceData>
+ </tm:occurrence>
+ </tm:topic>
+
+ <tm:topic id="UUID-died-event">
+ <tm:instanceOf><tm:topicRef href="#event"/></tm:instanceOf>
+ <tm:occurrence>
+ <tm:type><tm:topicRef href="#date"/></tm:type>
+ <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#date">22.03.1832</tm:resourceData>
+ </tm:occurrence>
+ </tm:topic>
+
+ <tm:topic id="weimar">
+ <tm:subjectIdentifier href="http://some.where/city/Weimar"/>
+ <tm:instanceOf><tm:topicRef href="#city"/></tm:instanceOf>
+ <tm:occurrence>
+ <tm:type><tm:topicRef href="#population"/></tm:type>
+ <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#unsignedLong">64720</tm:resourceData>
+ </tm:occurrence>
+ </tm:topic>
+
+ <tm:topic id="zauberlehrling">
+ <tm:subectIdentifier href="http://some.where/poem/Der_Zauberlehrling"/>
+ <tm:subectIdentifier href="http://some.where/poem/Zauberlehrling"/>
+ <tm:itemIdentity href="http://some.where/poem/Zauberlehrling_itemIdentity"/>
+ <tm:subjectLocator href="http://some.where/resource"/>
+ <tm:instanceOf><tm:topicRef href="#poem"/></tm:instanceOf>
+ <tm:occurrence>
+ <tm:type><tm:topicRef href="#title"/></tm:type>
+ <tm:scope>
+ <tm:topicRef href="#de"/>
+ <tm:topicRef href="#en"/>
+ </tm:scope>
+ <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string">Der Zauberlehrling</tm:resourceData>
+ </tm:occurrence>
+ <tm:occurrence>
+ <tm:type><tm:topicRef href="#content"/></tm:type>
+ <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string">Hat der alte Hexenmeister ...</tm:resourceData>
+ </tm:occurrence>
+ </tm:topic>
+
+ <tm:topic id="UUID-dateRange-1">
+ <tm:occurrence>
+ <tm:type><tm:topicRef href="#start"/></tm:type>
+ <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#date">01.01.1797</tm:resourceData>
+ </tm:occurrence>
+ <tm:occurrence>
+ <tm:type><tm:topicRef href="#end"/></tm:type>
+ <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#date">31.12.1797</tm:resourceData>
+ </tm:occurrence>
+ </tm:topic>
+
+ <tm:topic id="erlkoenig">
+ <tm:subjectIdentifier href="http://some.where/ballad/Der_Erlkoenig"/>
+ <tm:instanceOf><tm:topicRef href="#ballad"/></tm:instanceOf>
+ <tm:occurrence>
+ <tm:type><tm:topicRef href="#title"/></tm:type>
+ <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string">Der Erlkönig</tm:resourceData>
+ <tm:scope><tm:topicRef href="#en"/></tm:scope>
+ </tm:occurrence>
+ <tm:occurrence>
+ <tm:type><tm:topicRef href="#content"/></tm:type>
+ <tm:scope><tm:topicRef href="#de"/></tm:scope>
+ <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string">Wer reitet so spät durch Nacht und Wind? ...</tm:resourceData>
+ </tm:occurrence>
+ </tm:topic>
+
+ <tm:topic id="UUID-dateRange-2">
+ <tm:occurrence>
+ <tm:type><tm:topicRef href="#start"/></tm:type>
+ <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#date">01.01.1782</tm:resourceData>
+ </tm:occurrence>
+ <tm:occurrence>
+ <tm:type><tm:topicRef href="#end"/></tm:type>
+ <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#date">31.12.1782</tm:resourceData>
+ </tm:occurrence>
+ </tm:topic>
+
+ <tm:topic id="prometheus">
+ <tm:subjectIdentifier href="http://some.where/ballad/Prometheus"/>
+ <tm:instanceOf><tm:topicRef href="#poem"/></tm:instanceOf>
+ <tm:occurrence>
+ <tm:type><tm:topicRef href="#title"/></tm:type>
+ <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string">Prometheus</tm:resourceData>
+ <tm:scope><tm:topicRef href="#de"/></tm:scope>
+ </tm:occurrence>
+ <tm:occurrence>
+ <tm:type><tm:topicRef href="#content"/></tm:type>
+ <tm:scope><tm:topicRef href="#de"/></tm:scope>
+ <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string"> Bedecke deinen Himmel, Zeus, ... </tm:resourceData>
+ </tm:occurrence>
+ </tm:topic>
+
+ <tm:topic id="UUID-dateRange-3">
+ <tm:occurrence>
+ <tm:type><tm:topicRef href="#start"/></tm:type>
+ <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#date">01.01.1772</tm:resourceData>
+ </tm:occurrence>
+ <tm:occurrence>
+ <tm:type><tm:topicRef href="#end"/></tm:type>
+ <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#date">31.12.1774</tm:resourceData>
+ </tm:occurrence>
+ </tm:topic>
+
+ <tm:topic id="dateRange">
+ <tm:subjectIdentifier href="http://some.where/relationship/dateRange"/>
+ </tm:topic>
+
+ <tm:topic id="officialese">
+ <tm:subjectIdentifier href="http://some.where/relationship/officialese"/>
+ </tm:topic>
+
+ <tm:topic id="content">
+ <tm:subjectIdentifier href="http://some.where/relationship/content"/>
+ </tm:topic>
+
+ <tm:topic id="start">
+ <tm:subjectIdentifier href="http://some.where/relationship/start"/>
+ </tm:topic>
+
+ <tm:topic id="end">
+ <tm:subjectIdentifier href="http://some.where/relationship/end"/>
+ </tm:topic>
+
+ <tm:topic id="de">
+ <tm:subjectIdentifier href="http://isidorus/rdf2tm_mapping/scope/de"/>
+ </tm:topic>
+
+ <tm:topic id="en">
+ <tm:subjectIdentifier href="http://some.where/scope/en"/>
+ </tm:topic>
+
+ <tm:topic id="title">
+ <tm:subjetcIdentifier href="http://some.where/relationship/title"/>
+ </tm:topic>
+
+ <tm:topic id="poem">
+ <tm:subjectIdentifier href="http://some.where/types/Poem"/>
+ </tm:topic>
+
+ <tm:topic id="ballad">
+ <tm:subjectIdentifier href="http://some.where/types/Ballad"/>
+ </tm:topic>
+
+ <tm:topic id="supertype-subtype">
+ <tm:subjectIdentifier href="http://psi.topicmaps.org/iso13250/model/supertype-subtype"/>
+ </tm:topic>
+
+ <tm:topic id="supertype">
+ <tm:subjectIdentifier href="http://psi.topicmaps.org/iso13250/model/supertype"/>
+ </tm:topic>
+
+ <tm:topic id="subtype">
+ <tm:subjectIdentifier href="http://psi.topicmaps.org/iso13250/model/subtype"/>
+ </tm:topic>
+
+ <tm:topic id="region">
+ <tm:subjectIdentifier href="http://some.where/types/Region"/>
+ </tm:topic>
+
+ <tm:topic id="city">
+ <tm:subjectIdentifier href="http://some.where/types/City"/>
+ </tm:topic>
+
+ <tm:topic id="died">
+ <tm:subjectIdentifier href="http://some.where/relationship/died"/>
+ </tm:topic>
+
+ <tm:topic id="capital">
+ <tm:subjectIdentifier href="http://some.where/relationship/capital"/>
+ </tm:topic>
+
+ <tm:topic id="german">
+ <tm:subjectIdentifier href="http://some.where/language/German"/>
+ <tm:instanceOf><tm:topicRef href="#language"/></tm:instanceOf>
+ </tm:topic>
+
+ <tm:topic id="language">
+ <tm:subjectIdentifier href="http://some.where/types/Language"/>
+ </tm:topic>
+
+ <tm:topic id="population">
+ <tm:subjectIdentifier href="http://some.where/relationship/population"/>
+ </tm:topic>
+
+ <tm:topic id="nativeName">
+ <tm:subjectIdentifier href="http://some.where/relationship/nativeName"/>
+ </tm:topic>
+
+ <tm:topic id="country">
+ <tm:subjectIdentifier href="http://some.where/types/Country"/>
+ </tm:topic>
+
+ <tm:topic id="metropolis">
+ <tm:subjectIdentifier href="http://some.where/types/Metropolis"/>
+ </tm:topic>
+
+ <tm:topic id="locatedIn">
+ <tm:subjectIdentifier href="http://some.where/relationship/locatedIn"/>
+ </tm:topic>
+
+ <tm:topic id="place">
+ <tm:subjectIdentifier href="http://some.where/relationship/place"/>
+ </tm:topic>
+
+ <tm:topic id="fullName">
+ <tm:subjectIdentifier href="http://some.where/relationship/fullName"/>
+ </tm:topic>
+
+ <tm:topic id="date">
+ <tm:subjectIdentifier href="http://some.where/relationship/date"/>
+ </tm:topic>
+
+ <tm:topic id="born">
+ <tm:subjectIdentifier href="http://some.where/relationship/born"/>
+ </tm:topic>
+
+ <tm:topic id="author">
+ <tm:subjectIdentifier href="http://some.where/types/Author"/>
+ </tm:topic>
+
+ <tm:topic id="firstName">
+ <tm:subjectIdentifier href="http://some.where/relationship/firstName"/>
+ </tm:topic>
+
+ <tm:topic id="lastName">
+ <tm:subjectIdentifier href="http://some.where/relationsip/lastName"/>
+ </tm:topic>
+
+ <tm:topic id="event">
+ <tm:subjectIdentifier href="http://some.where/types/Event"/>
+ </tm:topic>
+
+ <tm:topic id="isi-subject">
+ <tm:subjectIdentifier href="http://isidorus/rdf2tm_mapping/subject"/>
+ </tm:topic>
+
+ <tm:topic id="isi-object">
+ <tm:subjectIdentifier href="http://isidorus/rdf2tm_mapping/object"/>
+ </tm:topic>
+
+ <tm:association>
+ <tm:type><tm:topicRef href="#born"/></tm:type>
+ <tm:role>
+ <tm:type><tm:topicRef href="#isi-subject"/></tm:type>
+ <tm:topicRef href="#goethe"/>
+ </tm:role>
+ <tm:role>
+ <tm:type><tm:topicRef href="#isi-object"/></tm:type>
+ <tm:topicRef href="#UUID-born-event"/>
+ </tm:role>
+ </tm:association>
+
+ <tm:association>
+ <tm:type><tm:topicRef href="#place"/></tm:type>
+ <tm:role>
+ <tm:type><tm:topicRef href="#isi-subject"/></tm:type>
+ <tm:topicRef href="#UUID-born-event"/>
+ </tm:role>
+ <tm:role>
+ <tm:type><tm:topicRef href="#isi-object"/></tm:type>
+ <tm:topicRef href="#frankfurt_m"/>
+ </tm:role>
+ </tm:association>
+
+ <tm:association>
+ <tm:type><tm:topicRef href="#locatedIn"/></tm:type>
+ <tm:role>
+ <tm:type><tm:topicRef href="#isi-subject"/></tm:type>
+ <tm:topicRef href="#frankfurt_m"/>
+ </tm:role>
+ <tm:role>
+ <tm:type><tm:topicRef href="#isi-object"/></tm:type>
+ <tm:topicRef href="#germany"/>
+ </tm:role>
+ </tm:association>
+
+ <tm:association>
+ <tm:type><tm:topicRef href="#officialese"/></tm:type>
+ <tm:role>
+ <tm:type><tm:topicRef href="#isi-subject"/></tm:type>
+ <tm:topicRef href="#germany"/>
+ </tm:role>
+ <tm:role>
+ <tm:type><tm:topicRef href="#isi-object"/></tm:type>
+ <tm:topicRef href="#german"/>
+ </tm:role>
+ </tm:association>
+
+ <tm:association>
+ <tm:type><tm:topicRef href="#locatedIn"/></tm:type>
+ <tm:role>
+ <tm:type><tm:topicRef href="#isi-subject"/></tm:type>
+ <tm:topicRef href="#berlin"/>
+ </tm:role>
+ <tm:role>
+ <tm:type><tm:topicRef href="#isi-object"/></tm:type>
+ <tm:topicRef href="#germany"/>
+ </tm:role>
+ </tm:association>
+
+ <tm:association>
+ <tm:type><tm:topicRef href="#capital"/></tm:type>
+ <tm:role>
+ <tm:type><tm:topicRef href="#isi-subject"/></tm:type>
+ <tm:topicRef href="#germany"/>
+ </tm:role>
+ <tm:role>
+ <tm:type><tm:topicRef href="#isi-object"/></tm:type>
+ <tm:topicRef href="#berlin"/>
+ </tm:role>
+ </tm:association>
+
+ <tm:association>
+ <tm:type><tm:topicRef href="#died"/></tm:type>
+ <tm:role>
+ <tm:type><tm:topicRef href="#isi-subject"/></tm:type>
+ <tm:topicRef href="#goethe"/>
+ </tm:role>
+ <tm:role>
+ <tm:type><tm:topicRef href="#isi-object"/></tm:type>
+ <tm:topicRef href="#UUID-died-event"/>
+ </tm:role>
+ </tm:association>
+
+ <tm:association>
+ <tm:type><tm:topicRef href="#place"/></tm:type>
+ <tm:role>
+ <tm:type><tm:topicRef href="#isi-subject"/></tm:type>
+ <tm:topicRef href="#UUID-died-event"/>
+ </tm:role>
+ <tm:role>
+ <tm:type><tm:topicRef href="#isi-object"/></tm:type>
+ <tm:topicRef href="#weimar"/>
+ </tm:role>
+ </tm:association>
+
+ <tm:association>
+ <tm:type><tm:topicRef href="#locatedIn"/></tm:type>
+ <tm:role>
+ <tm:type><tm:topicRef href="#isi-subject"/></tm:type>
+ <tm:topicRef href="#weimar"/>
+ </tm:role>
+ <tm:role>
+ <tm:type><tm:topicRef href="#isi-object"/></tm:type>
+ <tm:topicRef href="#germany"/>
+ </tm:role>
+ </tm:association>
+
+ <tm:association>
+ <tm:type><tm:topicRef href="#supertype-subtype"/></tm:type>
+ <tm:role>
+ <tm:type><tm:topicRef href="#supertype"/></tm:type>
+ <tm:topicRef href="#region"/>
+ </tm:role>
+ <tm:role>
+ <tm:type><tm:topicRef href="#subtype"/></tm:type>
+ <tm:topicRef href="#city"/>
+ </tm:role>
+ </tm:association>
+
+ <tm:association>
+ <tm:itemIdentity href="http://some.where/metropolis_supertye-subtype-association"/>
+ <tm:type><tm:topicRef href="#supertype-subtype"/></tm:type>
+ <tm:role>
+ <tm:type><tm:topicRef href="#supertype"/></tm:type>
+ <tm:topicRef href="#region"/>
+ </tm:role>
+ <tm:role>
+ <tm:type><tm:topicRef href="#subtype"/></tm:type>
+ <tm:topicRef href="#metropolis"/>
+ </tm:role>
+ </tm:association>
+
+ <tm:association>
+ <tm:type><tm:topicRef href="#dateRange"/></tm:type>
+ <tm:role>
+ <tm:type><tm:topicRef href="#isi-subject"/></tm:type>
+ <tm:topicRef href="#zauberlehrling"/>
+ </tm:role>
+ <tm:role>
+ <tm:type><tm:topicRef href="#isi-object"/></tm:type>
+ <tm:topicRef href="#UUID-dateRange-1"/>
+ </tm:role>
+ </tm:association>
+
+ <tm:association>
+ <tm:type><tm:topicRef href="#dateRange"/></tm:type>
+ <tm:role>
+ <tm:type><tm:topicRef href="#isi-subject"/></tm:type>
+ <tm:topicRef href="#erlkoenig"/>
+ </tm:role>
+ <tm:role>
+ <tm:type><tm:topicRef href="#isi-object"/></tm:type>
+ <tm:topicRef href="#UUID-dateRange-2"/>
+ </tm:role>
+ </tm:association>
+
+ <tm:association>
+ <tm:type><tm:topicRef href="#dateRange"/></tm:type>
+ <tm:role>
+ <tm:type><tm:topicRef href="#isi-subject"/></tm:type>
+ <tm:topicRef href="#prometheus"/>
+ </tm:role>
+ <tm:role>
+ <tm:type><tm:topicRef href="#isi-object"/></tm:type>
+ <tm:topicRef href="#UUID-dateRange-3"/>
+ </tm:role>
+ </tm:association>
+
+ <!-- the rdf:li elements are contained as a collection, to test the export
+ of collections -->
+ <tm:topic id="wrote">
+ <tm:subjectIdentifier href="http://some.where/relationship/wrote"/>
+ </tm:topic>
+
+ <tm:topic id="rest">
+ <tm:subjectIdentifier href="http://www.w3.org/1999/02/22-rdf-syntax-ns#rest"/>
+ </tm:topic>
+
+ <tm:topic id="first">
+ <tm:subjectIdentifier href="http://www.w3.org/1999/02/22-rdf-syntax-ns#first"/>
+ </tm:topic>
+
+ <tm:topic id="nil">
+ <tm:subjectIdentifier href="http://www.w3.org/1999/02/22-rdf-syntax-ns#nil"/>
+ </tm:topic>
+
+ <!-- first node -->
+ <tm:topic id="UUID-1-collection"/>
+
+ <tm:association>
+ <tm:type><tm:topicRef href="#wrote"/></tm:type>
+ <tm:role>
+ <tm:type><tm:topicRef href="#isi-subject"/></tm:type>
+ <tm:topicRef href="#goethe"/>
+ </tm:role>
+ <tm:role>
+ <tm:type><tm:topicRef href="#isi-object"/></tm:type>
+ <tm:topicRef href="#UUID-1-collection"/>
+ </tm:role>
+ </tm:association>
+
+ <tm:association>
+ <tm:type><tm:topicRef href="#first"/></tm:type>
+ <tm:role>
+ <tm:type><tm:topicRef href="#isi-subject"/></tm:type>
+ <tm:topicRef href="#UUID-1-collection"/>
+ </tm:role>
+ <tm:role>
+ <tm:type><tm:topicRef href="#isi-object"/></tm:type>
+ <tm:topicRef href="#zauberlehrling"/>
+ </tm:role>
+ </tm:association>
+
+ <tm:association>
+ <tm:type><tm:topicRef href="#rest"/></tm:type>
+ <tm:role>
+ <tm:type><tm:topicRef href="#isi-subject"/></tm:type>
+ <tm:topicRef href="#UUID-1-collection"/>
+ </tm:role>
+ <tm:role>
+ <tm:type><tm:topicRef href="#isi-object"/></tm:type>
+ <tm:topicRef href="#UUID-2-collection"/>
+ </tm:role>
+ </tm:association>
+
+ <!-- second node -->
+ <tm:topic id="UUID-2-collection"/>
+
+ <tm:association>
+ <tm:type><tm:topicRef href="#first"/></tm:type>
+ <tm:role>
+ <tm:type><tm:topicRef href="#isi-subject"/></tm:type>
+ <tm:topicRef href="#UUID-2-collection"/>
+ </tm:role>
+ <tm:role>
+ <tm:type><tm:topicRef href="#isi-object"/></tm:type>
+ <tm:topicRef href="#erlkoenig"/>
+ </tm:role>
+ </tm:association>
+
+ <tm:association>
+ <tm:type><tm:topicRef href="#rest"/></tm:type>
+ <tm:role>
+ <tm:type><tm:topicRef href="#isi-subject"/></tm:type>
+ <tm:topicRef href="#UUID-2-collection"/>
+ </tm:role>
+ <tm:role>
+ <tm:type><tm:topicRef href="#isi-object"/></tm:type>
+ <tm:topicRef href="#UUID-3-collection"/>
+ </tm:role>
+ </tm:association>
+
+ <!-- third node -->
+ <tm:topic id="UUID-3-collection"/>
+
+ <tm:association>
+ <tm:type><tm:topicRef href="#first"/></tm:type>
+ <tm:role>
+ <tm:type><tm:topicRef href="#isi-subject"/></tm:type>
+ <tm:topicRef href="#UUID-3-collection"/>
+ </tm:role>
+ <tm:role>
+ <tm:type><tm:topicRef href="#isi-object"/></tm:type>
+ <tm:topicRef href="#prometheus"/>
+ </tm:role>
+ </tm:association>
+
+ <tm:association>
+ <tm:type><tm:topicRef href="#rest"/></tm:type>
+ <tm:role>
+ <tm:type><tm:topicRef href="#isi-subject"/></tm:type>
+ <tm:topicRef href="#UUID-3-collection"/>
+ </tm:role>
+ <tm:role>
+ <tm:type><tm:topicRef href="#isi-object"/></tm:type>
+ <tm:topicRef href="#nil"/>
+ </tm:role>
+ </tm:association>
+</tm:topicMap>
\ No newline at end of file
Modified: trunk/src/unit_tests/rdf_importer_test.lisp
==============================================================================
--- trunk/src/unit_tests/rdf_importer_test.lisp (original)
+++ trunk/src/unit_tests/rdf_importer_test.lisp Mon Aug 24 12:37:40 2009
@@ -1793,7 +1793,7 @@
(prometheus "http://some.where/poem/Prometheus")
(erlkoenig "http://some.where/ballad/Der_Erlkoenig")
(date "http://www.w3.org/2001/XMLSchema#date")
- (de (d:get-item-by-id "http://isidorus/rdf2tm_mapping/scope#de"))
+ (de (d:get-item-by-id "http://isidorus/rdf2tm_mapping/scope/de"))
(long "http://www.w3.org/2001/XMLSchema#unsignedLong"))
(is (= (length topics) 65))
(is (= (length occs) 23))
@@ -1866,6 +1866,7 @@
(string= (d:uri (first (d:psis (d:instance-of x))))
(concatenate 'string arcs "title"))
(string= *xml-string* (d:datatype x))
+ (string= (d:charvalue x) "Der Zauberlehrling")
(= 1 (length (d:themes x)))
(eql (first (d:themes x)) de)
(= (length (d:psis (d:topic x))) 1)
@@ -1879,6 +1880,7 @@
(string= (d:uri (first (d:psis (d:instance-of x))))
(concatenate 'string arcs "title"))
(= 0 (length (d:themes x)))
+ (string= (d:charvalue x) "Prometheus")
(string= *xml-string* (d:datatype x))
(= (length (d:psis (d:topic x))) 1)
(string= (d:uri (first (d:psis (d:topic x))))
@@ -1891,6 +1893,7 @@
(string= (d:uri (first (d:psis (d:instance-of x))))
(concatenate 'string arcs "title"))
(string= *xml-string* (d:datatype x))
+ (string= (d:charvalue x) "Der Erlkönig")
(= 1 (length (d:themes x)))
(eql (first (d:themes x)) de)
(= (length (d:psis (d:topic x))) 1)
@@ -1904,6 +1907,7 @@
(string= (d:uri (first (d:psis (d:instance-of x))))
(concatenate 'string arcs "content"))
(string= *xml-string* (d:datatype x))
+ (string= (d:charvalue x) "Hat der alte Hexenmeister ...")
(= 1 (length (d:themes x)))
(eql (first (d:themes x)) de)
(= (length (d:psis (d:topic x))) 1)
@@ -1917,6 +1921,8 @@
(string= (d:uri (first (d:psis (d:instance-of x))))
(concatenate 'string arcs "content"))
(string= *xml-string* (d:datatype x))
+ (string= (d:charvalue x)
+ " Bedecke deinen Himmel, Zeus, ... ")
(= 1 (length (d:themes x)))
(eql (first (d:themes x)) de)
(= (length (d:psis (d:topic x))) 1)
@@ -1930,6 +1936,8 @@
(string= (d:uri (first (d:psis (d:instance-of x))))
(concatenate 'string arcs "content"))
(string= *xml-string* (d:datatype x))
+ (string= (d:charvalue x)
+ "Wer reitet so spät durch Nacht und Wind? ...")
(= 1 (length (d:themes x)))
(eql (first (d:themes x)) de)
(= (length (d:psis (d:topic x))) 1)
Modified: trunk/src/xml/rdf/exporter.lisp
==============================================================================
--- trunk/src/xml/rdf/exporter.lisp (original)
+++ trunk/src/xml/rdf/exporter.lisp Mon Aug 24 12:37:40 2009
@@ -4,4 +4,245 @@
;;+
;;+ Isidorus is freely distributable under the LGPL license.
;;+ You can find a detailed description in trunk/docs/LGPL-LICENSE.txt.
-;;+-----------------------------------------------------------------------------
\ No newline at end of file
+;;+-----------------------------------------------------------------------------
+
+(defpackage :rdf-exporter
+ (:use :cl :cxml :elephant :datamodel :isidorus-threading :datamodel)
+ (:import-from :constants
+ *rdf-ns*
+ *rdfs-ns*
+ *xml-ns*
+ *xml-string*
+ *xml-uri*
+ *rdf2tm-ns*
+ *rdf2tm-object*
+ *rdf2tm-subject*
+ *rdf2tm-scope-prefix*
+ *tm2rdf-ns*)
+ (:import-from :isidorus-threading
+ with-reader-lock
+ with-writer-lock)
+ (:import-from :exporter
+ *export-tm*
+ export-to-elem)
+ (:export :export-rdf))
+
+(in-package :rdf-exporter)
+
+
+(defvar *ns-map* nil) ;; ((:prefix <string> :uri <string>))
+
+
+(defun export-rdf (rdf-path &key tm-id (revision (get-revision)))
+ "Exports the topoic map bound to tm-id as RDF."
+ (with-reader-lock
+ (let ((tm (when tm-id
+ (get-item-by-item-identifier tm-id :revision revision))))
+ (setf *ns-map* nil)
+ (setf *export-tm* tm)
+ (with-revision revision
+ (with-open-file (stream rdf-path :direction :output)
+ (cxml:with-xml-output (cxml:make-character-stream-sink
+ stream :canonical nil)
+ (cxml:with-namespace ("isi" *tm2rdf-ns*)
+ (cxml:with-namespace ("rdf" *rdf-ns*)
+ (cxml:with-namespace ("rdfs" *rdfs-ns*)
+ (cxml:with-namespace ("xml" *xml-ns*)
+ (cxml:with-element "rdf:RDF"
+ (export-to-elem tm #'to-rdf-elem)))))))))))
+ (setf *ns-map* nil))
+
+
+(defun get-ns-prefix (ns-uri)
+ (let ((ns-entry
+ (find-if #'(lambda(x)
+ (string= (getf x :uri)
+ ns-uri))
+ *ns-map*)))
+ (if ns-entry
+ (getf ns-entry :prefix)
+ (let ((new-name (concatenate
+ 'string "ns"
+ (write-to-string (+ 1 (length *ns-map*))))))
+ (push (list :prefix new-name
+ :uri ns-uri)
+ *ns-map*)
+ new-name))))
+
+
+(defun separate-uri (uri)
+ (when (or (not uri)
+ (= (length uri) 0)
+ (and uri
+ (> (length uri) 0)
+ (or (eql (elt uri (- (length uri) 1)) #\#)
+ (eql (elt uri (- (length uri) 1)) #\/)
+ (eql (elt uri 0) #\#)
+ (eql (elt uri 0) #\/))))
+ (error "From separate-uri(): bad ns-uri: ~a" uri))
+ (let ((pos-hash (position #\# uri :from-end t))
+ (pos-slash (position #\/ uri :from-end t)))
+ (unless (or pos-hash pos-slash)
+ (error "From separate-uri(): bad ns-uri: ~a" uri))
+ (if (not (or pos-hash pos-slash))
+ (list :prefix *tm2rdf-ns*
+ :suffix uri)
+ (let ((prefix (subseq uri 0 (+ (max (or pos-hash 0) (or pos-slash 0)) 1)))
+ (suffix (subseq uri (+ (max (or pos-hash 0) (or pos-slash 0)) 1))))
+ (list :prefix prefix
+ :suffix suffix)))))
+
+
+(defun get-xml-lang (topic)
+ (declare (TopicC topic))
+ (when (xml-lang-p topic)
+ (subseq (uri (first (psis topic))) (length *rdf2tm-scope-prefix*))))
+
+
+(defun xml-lang-p (topic)
+ (declare (TopicC topic))
+ (when (= (length (psis topic)) 1)
+ (when (string-starts-with (uri (first (psis topic)))
+ *rdf2tm-scope-prefix*)
+ t)))
+
+
+(defun make-topic-id (topic)
+ (declare (TopicC topic))
+ (concatenate 'string "id_" (write-to-string (elephant::oid topic))))
+
+
+(defun make-topic-reference (topic)
+ (declare (TopicC topic))
+ (if (psis topic)
+ (cxml:attribute "rdf:resource" (uri (first (psis topic))))
+ (cxml:attribute "rdf:nodeID" (make-topic-id topic))))
+
+
+
+(defgeneric to-rdf-elem (construct)
+ (:documentation "Exports Topic Maps Constructs as RDF. "))
+
+
+(defmethod to-rdf-elem ((construct PersistentIdC))
+ (cxml:with-element "isi:subjectIdentifier"
+ (cxml:attribute "rdf:datatype" *xml-uri*)
+ (cxml:text (uri construct))))
+
+
+(defmethod to-rdf-elem ((construct SubjectLocatorC))
+ (cxml:with-element "isi:subjectLocator"
+ (cxml:attribute "rdf:datatype" *xml-uri*)
+ (cxml:text (uri construct))))
+
+
+(defmethod to-rdf-elem ((construct ItemIdentifierC))
+ (cxml:with-element "isi:itemIdentity"
+ (cxml:attribute "rdf:datatype" *xml-uri*)
+ (cxml:text (uri construct))))
+
+
+(defun scopes-to-rdf-elems (owner-construct)
+ (declare ((or AssociationC OccurrenceC NameC VariantC RoleC) owner-construct))
+ (map 'list #'(lambda(x)
+ (cxml:with-element "isi:scope"
+ (make-topic-reference x)))
+ (themes owner-construct)))
+
+
+(defun resourceX-to-rdf-elem (owner-construct)
+ (declare ((or OccurrenceC VariantC) owner-construct))
+ (cxml:with-element "isi:value"
+ (cxml:attribute "rdf:datatype" (datatype owner-construct))
+ (cxml:text (charvalue owner-construct))))
+
+
+(defmethod to-rdf-elem ((construct VariantC))
+ (cxml:with-element "isi:variant"
+ (cxml:attribute "rdf:parseType" "Resource")
+ (map 'list #'to-rdf-elem (item-identifiers construct))
+ (scopes-to-rdf-elems construct)
+ (resourceX-to-rdf-elem construct)))
+
+
+(defmethod to-rdf-elem ((construct NameC))
+ (cxml:with-element "isi:name"
+ (cxml:attribute "rdf:parseType" "Resource")
+ (map 'list #'to-rdf-elem (item-identifiers construct))
+ (cxml:with-element "isi:nametype"
+ (make-topic-reference (instance-of construct)))
+ (scopes-to-rdf-elems construct)
+ (cxml:with-element "isi:value"
+ (cxml:attribute "rdf:datatype" *xml-string*)
+ (cxml:text (charvalue construct)))
+ (map 'list #'to-rdf-elem (variants construct))))
+
+
+(defmethod to-rdf-elem ((construct OccurrenceC))
+ (let ((scopes (when (themes construct)
+ (loop for theme in (themes construct)
+ when (not (xml-lang-p theme))
+ collect theme))))
+ (if (or scopes
+ (item-identifiers construct)
+ (/= (length (psis (instance-of construct))) 1))
+ (cxml:with-element "isi:occurrence"
+ (cxml:attribute "rdf:parseType" "Resource")
+ (map 'list #'to-rdf-elem (item-identifiers construct))
+ (cxml:with-element "isi:occurrencetype"
+ (make-topic-reference (instance-of construct)))
+ (scopes-to-rdf-elems construct)
+ (resourceX-to-rdf-elem construct))
+ (let ((ns-list
+ (separate-uri (uri (first (psis (instance-of construct)))))))
+ (let ((ns (getf ns-list :prefix))
+ (tag-name (getf ns-list :suffix)))
+ (cxml:with-namespace ((get-ns-prefix ns) ns)
+ (cxml:with-element (concatenate 'string (get-ns-prefix ns)
+ ":" tag-name)
+ (cxml:attribute "rdf:datatype" (datatype construct))
+ (when (themes construct)
+ (cxml:attribute "xml:lang" (get-xml-lang
+ (first (themes construct)))))
+ (cxml:text (charvalue construct)))))))))
+
+
+(defmethod to-rdf-elem ((construct TopicC))
+ ;TODO: what's with used-as-player and core-topics
+ (format t "--> ~a " (if (psis construct)
+ (uri (first (psis construct)))
+ (make-topic-id construct)))
+ (if (and (not (or (> (length (psis construct)) 1)
+ (item-identifiers construct)
+ (locators construct)
+ (names construct)
+ (occurrences construct)))
+ (or (used-as-type construct)
+ (used-as-theme construct)))
+ nil ;; do not export this topic explicitly, since it is exported as
+ ;; rdf:resource, rdf:about or any other reference
+ (cxml:with-element "rdf:Description"
+ (let ((psi (when (psis construct)
+ (first (psis construct)))))
+ (if psi
+ (cxml:attribute "rdf:about" (uri psi))
+ (cxml:attribute "rdf:nodeID" (make-topic-id construct)))
+ (map 'list #'to-rdf-elem (remove psi (psis construct)))
+ (map 'list #'to-rdf-elem (locators construct))
+ (map 'list #'to-rdf-elem (item-identifiers construct))
+ (map 'list #'(lambda(x)
+ (cxml:with-element "rdf:type"
+ (make-topic-reference x)))
+ (list-instanceOf construct))
+ (map 'list #'(lambda(x)
+ (cxml:with-element "rdfs:subClassOf"
+ (make-topic-reference x)))
+ (list-super-types construct))
+ (map 'list #'to-rdf-elem (names construct))
+ (map 'list #'to-rdf-elem (occurrences construct)))))
+ (format t "<--~%"))
+
+
+(defmethod to-rdf-elem ((construct AssociationC))
+ ;TODO: check if the association has to be exported or not
+ )
\ No newline at end of file
Modified: trunk/src/xml/rdf/importer.lisp
==============================================================================
--- trunk/src/xml/rdf/importer.lisp (original)
+++ trunk/src/xml/rdf/importer.lisp Mon Aug 24 12:37:40 2009
@@ -589,7 +589,7 @@
(defun get-literals-of-node-content (node tm-id xml-base xml-lang)
"Returns a list of literals that is produced of a node's content."
(declare (dom:element node))
- (tm-id-p tm-id "get-literals-of-content")
+ (tm-id-p tm-id "get-literals-of-noode-content")
(let ((properties (child-nodes-or-text node :trim t))
(fn-xml-base (get-xml-base node :old-base xml-base))
(fn-xml-lang (get-xml-lang node :old-lang xml-lang)))
@@ -607,7 +607,8 @@
property nil))
(prop-content (child-nodes-or-text property)))
(and (or datatype
- (string= parseType "Literal")
+ (and parseType
+ (string= parseType "Literal"))
(and (not (or nodeID resource UUID parseType))
(or (not prop-content)
(stringp prop-content))))
Modified: trunk/src/xml/rdf/rdf_core_psis.xtm
==============================================================================
--- trunk/src/xml/rdf/rdf_core_psis.xtm (original)
+++ trunk/src/xml/rdf/rdf_core_psis.xtm Mon Aug 24 12:37:40 2009
@@ -11,14 +11,14 @@
<topicMap xmlns="http://www.topicmaps.org/xtm/" version="2.0">
<topic id="subject">
- <subjectIdentifier href="http://isidorus/rdf2tm_mapping#subject"/>
+ <subjectIdentifier href="http://isidorus/rdf2tm_mapping/subject"/>
<name>
<value>subject</value>
</name>
</topic>
<topic id="object">
- <subjectIdentifier href="http://isidorus/rdf2tm_mapping#object"/>
+ <subjectIdentifier href="http://isidorus/rdf2tm_mapping/object"/>
<name>
<value>object</value>
</name>
Modified: trunk/src/xml/rdf/rdf_tools.lisp
==============================================================================
--- trunk/src/xml/rdf/rdf_tools.lisp (original)
+++ trunk/src/xml/rdf/rdf_tools.lisp Mon Aug 24 12:37:40 2009
@@ -33,8 +33,7 @@
*rdf-rest*
*rdf2tm-scope-prefix*)
(:import-from :xml-constants
- *rdf_core_psis.xtm*)
- (:import-from :xml-constants
+ *rdf_core_psis.xtm*
*core_psis.xtm*)
(:import-from :xml-tools
get-attribute
@@ -306,7 +305,6 @@
(when (and (string= property-ns *rdf-ns*)
(string= property-name "li"))
(set-_n-name owner-identifier property)))
- ;(set-_n-name property _n-counter)))
t)
@@ -371,6 +369,7 @@
datatype))
(when (and (or nodeID resource)
(> (length content) 0))
+ ;(set-_n-name property _n-counter)))
(error "~awhen ~a is set no content is allowed: ~a!"
err-pref
(cond
@@ -428,7 +427,6 @@
function and sets all rdf:li properties as a tupple to the
*_n-map* list."
(let ((child-nodes (child-nodes-or-text node :trim t)))
- ;(_n-counter 0))
(when (get-ns-attribute node "li")
(dom:map-node-map
#'(lambda(attr)
1
0
Author: lgiessmann
Date: Tue Aug 18 13:16:21 2009
New Revision: 116
Log:
rdf-importer: fixed a bug with parsing property nodes
Modified:
trunk/src/unit_tests/rdf_importer_test.lisp
trunk/src/xml/rdf/importer.lisp
trunk/src/xml/rdf/rdf_tools.lisp
Modified: trunk/src/unit_tests/rdf_importer_test.lisp
==============================================================================
--- trunk/src/unit_tests/rdf_importer_test.lisp (original)
+++ trunk/src/unit_tests/rdf_importer_test.lisp Tue Aug 18 13:16:21 2009
@@ -332,7 +332,6 @@
(dom:set-attribute-ns prop *rdf-ns* "unknown" "unknown")
(is-true (rdf-importer::parse-property prop 0))
(dom:append-child prop text-node)
- (signals error (rdf-importer::parse-property prop 0))
(dom:remove-child prop text-node)
(is-true (rdf-importer::parse-property prop 0))
(dom:remove-attribute-ns prop *rdf-ns* "unknown")
Modified: trunk/src/xml/rdf/importer.lisp
==============================================================================
--- trunk/src/xml/rdf/importer.lisp (original)
+++ trunk/src/xml/rdf/importer.lisp Tue Aug 18 13:16:21 2009
@@ -876,8 +876,8 @@
(error "~aliteral content not allowed here: ~a"
err-pref content))
(loop for arc across content
- do (import-arc arc tm-id start-revision :document-id document-id
- :xml-base fn-xml-base :xml-lang fn-xml-lang))))
+ collect (import-arc arc tm-id start-revision :document-id document-id
+ :xml-base fn-xml-base :xml-lang fn-xml-lang))))
(defun make-recursion-from-arc (arc tm-id start-revision
Modified: trunk/src/xml/rdf/rdf_tools.lisp
==============================================================================
--- trunk/src/xml/rdf/rdf_tools.lisp (original)
+++ trunk/src/xml/rdf/rdf_tools.lisp Tue Aug 18 13:16:21 2009
@@ -359,24 +359,29 @@
(when (and nodeID resource)
(error "~aondly one of rdf:nodeID and rdf:resource is allowed: (~a) (~a)!"
err-pref nodeID resource))
- (when (and (or nodeID resource type)
+ (when (and (or nodeID resource type literals)
datatype)
(error "~aonly one of ~a and rdf:datatype (~a) is allowed!"
err-pref
(cond
(nodeID (concatenate 'string "rdf:nodeID (" nodeID ")"))
(resource (concatenate 'string "rdf:resource (" resource ")"))
- (type (concatenate 'string "rdf:type (" type ")")))
+ (type (concatenate 'string "rdf:type (" type ")"))
+ (literals literals))
datatype))
- (when (and (or type nodeID resource)
+ (when (and (or nodeID resource)
(> (length content) 0))
(error "~awhen ~a is set no content is allowed: ~a!"
err-pref
(cond
- (type (concatenate 'string "rdf:type (" type ")"))
(nodeID (concatenate 'string "rdf:nodeID (" nodeID ")"))
(resource (concatenate 'string "rdf:resource (" resource ")")))
content))
+ (when (and type
+ (stringp content)
+ (> (length content) 0))
+ (error "~awhen rdf:type is set no literal content is allowed: ~a!"
+ err-pref content))
(when (and (or type
(and (string= node-name "type")
(string= node-ns *rdf-ns*))
1
0
Author: lgiessmann
Date: Tue Aug 18 09:50:24 2009
New Revision: 115
Log:
rdf-mporter: moved all calls of the elephant-macro "ensure-transaction" to the two public and top layered functions "setup-rdf-module" and "rdf-importer"
Modified:
trunk/src/xml/rdf/importer.lisp
trunk/src/xml/rdf/rdf_tools.lisp
Modified: trunk/src/xml/rdf/importer.lisp
==============================================================================
--- trunk/src/xml/rdf/importer.lisp (original)
+++ trunk/src/xml/rdf/importer.lisp Tue Aug 18 09:50:24 2009
@@ -41,12 +41,13 @@
(unless elephant:*store-controller*
(elephant:open-store
(get-store-spec repository-path)))
- (let ((rdf-dom
- (dom:document-element (cxml:parse-file
- (truename rdf-xml-path)
- (cxml-dom:make-dom-builder)))))
- (import-dom rdf-dom start-revision :tm-id tm-id :document-id document-id))
- (setf *_n-map* nil)))
+ (elephant:ensure-transaction (:txn-nosync t)
+ (let ((rdf-dom
+ (dom:document-element (cxml:parse-file
+ (truename rdf-xml-path)
+ (cxml-dom:make-dom-builder)))))
+ (import-dom rdf-dom start-revision :tm-id tm-id :document-id document-id))
+ (setf *_n-map* nil))))
(defun init-rdf-module (&optional (revision (get-revision)))
@@ -57,22 +58,16 @@
(let
((core-dom
(cxml:parse-file *rdf_core_psis.xtm* (cxml-dom:make-dom-builder))))
- (loop for top-elem across
- (xpath-child-elems-by-qname (dom:document-element core-dom)
- *xtm2.0-ns* "topic")
- do
- (let
- ((top
- (from-topic-elem-to-stub top-elem revision
- :xtm-id *rdf-core-xtm*)))
- (add-to-topicmap xml-importer::tm top)))))))
-
-
-(defun tm-id-p (tm-id fun-name)
- "Checks the validity of the passed tm-id."
- (unless (absolute-uri-p tm-id)
- (error "From ~a(): you must provide a stable identifier (PSI-style) for this TM: ~a!"
- fun-name tm-id)))
+ (elephant:ensure-transaction (:txn-nosync t)
+ (loop for top-elem across
+ (xpath-child-elems-by-qname (dom:document-element core-dom)
+ *xtm2.0-ns* "topic")
+ do
+ (let
+ ((top
+ (from-topic-elem-to-stub top-elem revision
+ :xtm-id *rdf-core-xtm*)))
+ (add-to-topicmap xml-importer::tm top))))))))
(defun import-dom (rdf-dom start-revision
@@ -126,24 +121,23 @@
(super-classes
(get-super-classes-of-node-content elem tm-id xml-base)))
(with-tm (start-revision document-id tm-id)
- (elephant:ensure-transaction (:txn-nosync t)
- (let ((this
- (make-topic-stub
- about ID nodeID UUID start-revision xml-importer::tm
- :document-id document-id)))
- (make-literals this literals tm-id start-revision
- :document-id document-id)
- (make-associations this associations xml-importer::tm
- start-revision :document-id document-id)
- (make-types this types xml-importer::tm start-revision
- :document-id document-id)
- (make-super-classes this super-classes xml-importer::tm
- start-revision :document-id document-id)
- (make-recursion-from-node elem tm-id start-revision
- :document-id document-id
- :xml-base xml-base
- :xml-lang xml-lang)
- this)))))))
+ (let ((this
+ (make-topic-stub
+ about ID nodeID UUID start-revision xml-importer::tm
+ :document-id document-id)))
+ (make-literals this literals tm-id start-revision
+ :document-id document-id)
+ (make-associations this associations xml-importer::tm
+ start-revision :document-id document-id)
+ (make-types this types xml-importer::tm start-revision
+ :document-id document-id)
+ (make-super-classes this super-classes xml-importer::tm
+ start-revision :document-id document-id)
+ (make-recursion-from-node elem tm-id start-revision
+ :document-id document-id
+ :xml-base xml-base
+ :xml-lang xml-lang)
+ this))))))
(defun import-arc (elem tm-id start-revision
@@ -360,21 +354,20 @@
(unless (or role-type-1 role-type-2)
(error "~aone of the role types ~a ~a is missing!"
err-pref *supertype-psi* *subtype-psi*))
- (elephant:ensure-transaction (:txn-nosync t)
- (let ((a-roles (list (list :instance-of role-type-1
- :player super-top)
- (list :instance-of role-type-2
- :player sub-top))))
- (when reifier-id
- (make-reification reifier-id sub-top super-top
- assoc-type start-revision tm
- :document-id document-id))
- (add-to-topicmap
- tm
- (make-construct 'AssociationC
- :start-revision start-revision
- :instance-of assoc-type
- :roles a-roles))))))
+ (let ((a-roles (list (list :instance-of role-type-1
+ :player super-top)
+ (list :instance-of role-type-2
+ :player sub-top))))
+ (when reifier-id
+ (make-reification reifier-id sub-top super-top
+ assoc-type start-revision tm
+ :document-id document-id))
+ (add-to-topicmap
+ tm
+ (make-construct 'AssociationC
+ :start-revision start-revision
+ :instance-of assoc-type
+ :roles a-roles)))))
(defun make-instance-of-association (instance-top type-top reifier-id
@@ -399,21 +392,20 @@
(unless (or roletype-1 roletype-2)
(error "~aone of the role types ~a ~a is missing!"
err-pref *type-psi* *instance-psi*))
- (elephant:ensure-transaction (:txn-nosync t)
- (let ((a-roles (list (list :instance-of roletype-1
- :player type-top)
- (list :instance-of roletype-2
- :player instance-top))))
- (when reifier-id
- (make-reification reifier-id instance-top type-top
- assoc-type start-revision tm
- :document-id document-id))
- (add-to-topicmap
- tm
- (make-construct 'AssociationC
- :start-revision start-revision
- :instance-of assoc-type
- :roles a-roles))))))
+ (let ((a-roles (list (list :instance-of roletype-1
+ :player type-top)
+ (list :instance-of roletype-2
+ :player instance-top))))
+ (when reifier-id
+ (make-reification reifier-id instance-top type-top
+ assoc-type start-revision tm
+ :document-id document-id))
+ (add-to-topicmap
+ tm
+ (make-construct 'AssociationC
+ :start-revision start-revision
+ :instance-of assoc-type
+ :roles a-roles)))))
(defun make-topic-stub (about ID nodeId UUID start-revision
@@ -438,20 +430,19 @@
inner-top))))
(if top
top
- (elephant:ensure-transaction (:txn-nosync t)
- (let ((psi (when psi-uri
- (make-instance 'PersistentIdC
- :uri psi-uri
- :start-revision start-revision))))
- (handler-case (add-to-topicmap
- tm
- (make-construct 'TopicC
- :topicid topic-id
- :psis (when psi (list psi))
- :xtm-id document-id
- :start-revision start-revision))
- (Condition (err)(error "Creating topic ~a failed: ~a"
- topic-id err)))))))))
+ (let ((psi (when psi-uri
+ (make-instance 'PersistentIdC
+ :uri psi-uri
+ :start-revision start-revision))))
+ (handler-case (add-to-topicmap
+ tm
+ (make-construct 'TopicC
+ :topicid topic-id
+ :psis (when psi (list psi))
+ :xtm-id document-id
+ :start-revision start-revision))
+ (Condition (err)(error "Creating topic ~a failed: ~a"
+ topic-id err))))))))
(defun make-lang-topic (lang start-revision tm
@@ -479,30 +470,29 @@
(player-id (getf association :topicid))
(player-psi (getf association :psi))
(ID (getf association :ID)))
- (elephant:ensure-transaction (:txn-nosync t)
- (let ((player-1 (make-topic-stub player-psi nil player-id nil
- start-revision
- tm :document-id document-id))
- (role-type-1
- (make-topic-stub *rdf2tm-object* nil nil nil
- start-revision tm :document-id document-id))
- (role-type-2
- (make-topic-stub *rdf2tm-subject* nil nil nil
- start-revision tm :document-id document-id))
- (type-top (make-topic-stub type nil nil nil start-revision
- tm :document-id document-id)))
- (let ((roles (list (list :instance-of role-type-1
- :player player-1)
- (list :instance-of role-type-2
- :player top))))
- (when ID
- (make-reification ID top player-1 type-top start-revision
- tm :document-id document-id))
- (add-to-topicmap tm (make-construct 'AssociationC
- :start-revision start-revision
- :instance-of type-top
- :roles roles)))))))
-
+ (let ((player-1 (make-topic-stub player-psi nil player-id nil
+ start-revision
+ tm :document-id document-id))
+ (role-type-1
+ (make-topic-stub *rdf2tm-object* nil nil nil
+ start-revision tm :document-id document-id))
+ (role-type-2
+ (make-topic-stub *rdf2tm-subject* nil nil nil
+ start-revision tm :document-id document-id))
+ (type-top (make-topic-stub type nil nil nil start-revision
+ tm :document-id document-id)))
+ (let ((roles (list (list :instance-of role-type-1
+ :player player-1)
+ (list :instance-of role-type-2
+ :player top))))
+ (when ID
+ (make-reification ID top player-1 type-top start-revision
+ tm :document-id document-id))
+ (add-to-topicmap tm (make-construct 'AssociationC
+ :start-revision start-revision
+ :instance-of type-top
+ :roles roles))))))
+
(defun make-association-with-nodes (subject-topic object-topic
associationtype-topic tm start-revision
@@ -520,11 +510,10 @@
:player subject-topic)
(list :instance-of role-type-2
:player object-topic))))
- (elephant:ensure-transaction (:txn-nosync t)
- (add-to-topicmap tm (make-construct 'AssociationC
- :start-revision start-revision
- :instance-of associationtype-topic
- :roles roles))))))
+ (add-to-topicmap tm (make-construct 'AssociationC
+ :start-revision start-revision
+ :instance-of associationtype-topic
+ :roles roles)))))
(defun make-reification (reifier-id subject object predicate start-revision tm
@@ -545,24 +534,23 @@
tm :document-id document-id))
(statement (make-topic-stub *rdf-statement* nil nil nil start-revision
tm :document-id document-id)))
- (elephant:ensure-transaction (:txn-nosync t)
- (make-instance-of-association reifier statement nil start-revision tm
- :document-id document-id)
- (make-association-with-nodes reifier subject subject-arc tm
- start-revision :document-id document-id)
- (make-association-with-nodes reifier predicate predicate-arc
- tm start-revision :document-id document-id)
- (if (typep object 'd:TopicC)
- (make-association-with-nodes reifier object object-arc
- tm start-revision
- :document-id document-id)
- (make-construct 'd:OccurrenceC
- :start-revision start-revision
- :topic reifier
- :themes (themes object)
- :instance-of (instance-of object)
- :charvalue (charvalue object)
- :datatype (datatype object))))))
+ (make-instance-of-association reifier statement nil start-revision tm
+ :document-id document-id)
+ (make-association-with-nodes reifier subject subject-arc tm
+ start-revision :document-id document-id)
+ (make-association-with-nodes reifier predicate predicate-arc
+ tm start-revision :document-id document-id)
+ (if (typep object 'd:TopicC)
+ (make-association-with-nodes reifier object object-arc
+ tm start-revision
+ :document-id document-id)
+ (make-construct 'd:OccurrenceC
+ :start-revision start-revision
+ :topic reifier
+ :themes (themes object)
+ :instance-of (instance-of object)
+ :charvalue (charvalue object)
+ :datatype (datatype object)))))
(defun make-occurrence (top literal start-revision tm-id
@@ -577,26 +565,25 @@
(lang (getf literal :lang))
(datatype (getf literal :datatype))
(ID (getf literal :ID)))
- (elephant:ensure-transaction (:txn-nosync t)
- (let ((type-top (make-topic-stub type nil nil nil start-revision
- xml-importer::tm
- :document-id document-id))
- (lang-top (make-lang-topic lang start-revision
- xml-importer::tm
- :document-id document-id)))
- (let ((occurrence
- (make-construct 'OccurrenceC
- :start-revision start-revision
- :topic top
- :themes (when lang-top
- (list lang-top))
- :instance-of type-top
- :charvalue value
- :datatype datatype)))
- (when ID
- (make-reification ID top occurrence type-top start-revision
- xml-importer::tm :document-id document-id))
- occurrence))))))
+ (let ((type-top (make-topic-stub type nil nil nil start-revision
+ xml-importer::tm
+ :document-id document-id))
+ (lang-top (make-lang-topic lang start-revision
+ xml-importer::tm
+ :document-id document-id)))
+ (let ((occurrence
+ (make-construct 'OccurrenceC
+ :start-revision start-revision
+ :topic top
+ :themes (when lang-top
+ (list lang-top))
+ :instance-of type-top
+ :charvalue value
+ :datatype datatype)))
+ (when ID
+ (make-reification ID top occurrence type-top start-revision
+ xml-importer::tm :document-id document-id))
+ occurrence)))))
(defun get-literals-of-node-content (node tm-id xml-base xml-lang)
Modified: trunk/src/xml/rdf/rdf_tools.lisp
==============================================================================
--- trunk/src/xml/rdf/rdf_tools.lisp (original)
+++ trunk/src/xml/rdf/rdf_tools.lisp Tue Aug 18 09:50:24 2009
@@ -459,4 +459,11 @@
(get-absolute-attribute elem tm-id fn-xml-base "datatype")))
(if datatype
datatype
- *xml-string*))))
\ No newline at end of file
+ *xml-string*))))
+
+
+(defun tm-id-p (tm-id fun-name)
+ "Checks the validity of the passed tm-id."
+ (unless (absolute-uri-p tm-id)
+ (error "From ~a(): you must provide a stable identifier (PSI-style) for this TM: ~a!"
+ fun-name tm-id)))
\ No newline at end of file
1
0
Author: lgiessmann
Date: Thu Aug 13 17:19:31 2009
New Revision: 114
Log:
rdf-importer: fixed a bug with xml-base
Modified:
trunk/src/unit_tests/rdf_importer_test.lisp
trunk/src/xml/xtm/tools.lisp
Modified: trunk/src/unit_tests/rdf_importer_test.lisp
==============================================================================
--- trunk/src/unit_tests/rdf_importer_test.lisp (original)
+++ trunk/src/unit_tests/rdf_importer_test.lisp Thu Aug 13 17:19:31 2009
@@ -59,7 +59,8 @@
:test-poems-rdf-typing
:test-poems-rdf-topics
:test-empty-collection
- :test-collection))
+ :test-collection
+ :test-xml-base))
(declaim (optimize (debug 3) (speed 0) (safety 3) (space 0) (compilation-speed 0)))
@@ -1755,7 +1756,6 @@
4))
(is (= (length (d:player-in-roles fourth-node)) 1))
(is (= (length (d:player-in-roles fifth-node)) 1))
- (format t "--->")
(let ((col-2
(d:player
(find-if
@@ -2981,6 +2981,73 @@
(d:player-in-roles node))))))))
+(test test-xml-base
+ "Tests the function get-xml-base."
+ (let ((doc-1
+ (concatenate 'string "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" "
+ "xmlns:arcs=\"http://test/arcs/\">"
+ " <rdf:Description xml:base=\"http://base-1\"/>"
+ " <rdf:Description xml:base=\"http://base-2#\"/>"
+ " <rdf:Description xml:base=\"http://base-3/\"/>"
+ "</rdf:RDF>")))
+ (let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder))))
+ (let ((rdf-node (elt (dom:child-nodes dom-1) 0)))
+ (let ((n-1 (elt (rdf-importer::child-nodes-or-text rdf-node
+ :trim t) 0))
+ (n-2 (elt (rdf-importer::child-nodes-or-text rdf-node
+ :trim t) 1))
+ (n-3 (elt (rdf-importer::child-nodes-or-text rdf-node
+ :trim t) 2)))
+ (is (string= (xml-tools::concatenate-uri
+ (xml-tools:get-xml-base n-1)
+ "test")
+ "http://base-1/test"))
+ (is (string= (xml-tools::concatenate-uri
+ (xml-tools:get-xml-base n-1)
+ "/test")
+ "http://base-1/test"))
+ (is (string= (xml-tools::concatenate-uri
+ (xml-tools:get-xml-base n-1)
+ "#test")
+ "http://base-1#test"))
+ (is (string= (xml-tools::concatenate-uri
+ (xml-tools:get-xml-base n-2)
+ "test")
+ "http://base-2#test"))
+ (is (string= (xml-tools::concatenate-uri
+ (xml-tools:get-xml-base n-2)
+ "#test")
+ "http://base-2#test"))
+ (is (string= (xml-tools::concatenate-uri
+ (xml-tools:get-xml-base n-2)
+ "/test")
+ "http://base-2/test"))
+ (is (string= (xml-tools::concatenate-uri
+ (xml-tools:get-xml-base n-2)
+ "/t/est")
+ "http://base-2/t/est"))
+ (is (string= (xml-tools::concatenate-uri
+ (xml-tools:get-xml-base n-2)
+ "t/est")
+ "http://base-2/t/est"))
+ (signals error (xml-tools::concatenate-uri
+ (xml-tools:get-xml-base n-2) ""))
+ (signals error (xml-tools::concatenate-uri
+ "" "test"))
+ (is (string= (xml-tools::concatenate-uri
+ (xml-tools:get-xml-base n-3)
+ "test")
+ "http://base-3/test"))
+ (is (string= (xml-tools::concatenate-uri
+ (xml-tools:get-xml-base n-3)
+ "#test")
+ "http://base-3/#test"))
+ (is (string= (xml-tools::concatenate-uri
+ (xml-tools:get-xml-base n-3)
+ "/test")
+ "http://base-3/test")))))))
+
+
(defun run-rdf-importer-tests()
(when elephant:*store-controller*
(elephant:close-store))
@@ -3001,4 +3068,5 @@
(it.bese.fiveam:run! 'test-poems-rdf-typing)
(it.bese.fiveam:run! 'test-poems-rdf-topics)
(it.bese.fiveam:run! 'test-empty-collection)
- (it.bese.fiveam:run! 'test-collection))
\ No newline at end of file
+ (it.bese.fiveam:run! 'test-collection)
+ (it.bese.fiveam:run! 'test-xml-base))
\ No newline at end of file
Modified: trunk/src/xml/xtm/tools.lisp
==============================================================================
--- trunk/src/xml/xtm/tools.lisp (original)
+++ trunk/src/xml/xtm/tools.lisp Thu Aug 13 17:19:31 2009
@@ -44,27 +44,38 @@
"Returns a string conctenated of the absolut namespace an the given value
separated by either '#' or '/'."
(declare (string absolute-ns value))
- (unless (or (> (length absolute-ns) 0)
- (> (length value) 0))
+ (unless (and (> (length absolute-ns) 0)
+ (> (length value) 0))
(error "From concatenate-uri(): absolute-ns and value must be of length > 0"))
(unless (absolute-uri-p absolute-ns)
(error "From concatenate-uri(): absolute-ns has to be an absolute URI: ~a" absolute-ns))
(let ((last-char
- (elt absolute-ns (- (length absolute-ns) 1))))
+ (elt absolute-ns (- (length absolute-ns) 1)))
+ (first-char
+ (elt value 0)))
(let ((separator
(cond
- ((eql last-char #\#)
- "#")
- ((eql last-char #\/)
- "/")
+ ((or (eql first-char #\#)
+ (eql first-char #\/))
+ "")
+ ((or (eql last-char #\#)
+ (eql last-char #\/))
+ "")
(t
- "#")))
- (prep-ns
- (if (or (eql last-char #\#)
- (eql last-char #\/))
- (subseq absolute-ns 0 (- (length absolute-ns) 1))
- absolute-ns)))
- (concatenate 'string prep-ns separator value))))
+ "/"))))
+ (let ((prep-ns
+ (if (and (eql last-char first-char)
+ (or (eql last-char #\#)
+ (eql last-char #\/)))
+ (subseq absolute-ns 0 (- (length absolute-ns) 1))
+ (if (and (eql last-char #\#)
+ (find #\/ value))
+ (progn
+ (when (not (eql first-char #\/))
+ (setf separator "/"))
+ (subseq absolute-ns 0 (- (length absolute-ns) 1)))
+ absolute-ns))))
+ (concatenate 'string prep-ns separator value)))))
(defun absolutize-id (id xml-base tm-id)
@@ -142,9 +153,11 @@
(declare (dom:element elem))
(let ((new-base
(let ((inner-base
- (if (find #\# (get-ns-attribute elem "base" :ns-uri *xml-ns*))
+ (if (> (count #\# (get-ns-attribute elem "base"
+ :ns-uri *xml-ns*))
+ 1)
(error "From get-xml-base(): the base-uri ~a is not valid"
- (get-ns-attribute elem *xml-ns* "base"))
+ (get-ns-attribute elem "base" :ns-uri *xml-ns*))
(when (get-ns-attribute elem "base" :ns-uri *xml-ns*)
(string-trim '(#\Space #\Tab #\Newline)
(get-ns-attribute elem "base" :ns-uri *xml-ns*))))))
@@ -152,7 +165,6 @@
(eql (elt inner-base 0) #\/))
(subseq inner-base 1 (length inner-base))
inner-base))))
-
(if (or (absolute-uri-p new-base)
(not old-base))
new-base
1
0
Author: lgiessmann
Date: Thu Aug 13 15:47:53 2009
New Revision: 113
Log:
rdf-importer: finalized the rdf-importer -> collections are imported as linked lists modelled as tm-associations (equal to manual created rdf-collections
Modified:
trunk/src/constants.lisp
trunk/src/unit_tests/rdf_importer_test.lisp
trunk/src/xml/rdf/importer.lisp
trunk/src/xml/rdf/rdf_core_psis.xtm
trunk/src/xml/rdf/rdf_tools.lisp
Modified: trunk/src/constants.lisp
==============================================================================
--- trunk/src/constants.lisp (original)
+++ trunk/src/constants.lisp Thu Aug 13 15:47:53 2009
@@ -37,7 +37,6 @@
:*rdf-rest*
:*rdf2tm-object*
:*rdf2tm-subject*
- :*rdf2tm-collection*
:*rdf2tm-scope-prefix*))
(in-package :constants)
@@ -95,6 +94,4 @@
(defparameter *rdf2tm-subject* "http://isidorus/rdf2tm_mapping#subject")
-(defparameter *rdf2tm-collection* "http://isidorus/rdf2tm_mapping#collection")
-
(defparameter *rdf2tm-scope-prefix* "http://isidorus/rdf2tm_mapping/scope#")
\ No newline at end of file
Modified: trunk/src/unit_tests/rdf_importer_test.lisp
==============================================================================
--- trunk/src/unit_tests/rdf_importer_test.lisp (original)
+++ trunk/src/unit_tests/rdf_importer_test.lisp Thu Aug 13 15:47:53 2009
@@ -57,7 +57,9 @@
:test-poems-rdf-occurrences
:test-poems-rdf-associations
:test-poems-rdf-typing
- :test-poems-rdf-topics))
+ :test-poems-rdf-topics
+ :test-empty-collection
+ :test-collection))
(declaim (optimize (debug 3) (speed 0) (safety 3) (space 0) (compilation-speed 0)))
@@ -1034,7 +1036,7 @@
(rdf-init-db :db-dir db-dir :start-revision revision-1)
(rdf-importer::import-node node tm-id revision-2
:document-id document-id)
- (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 21))
+ (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 20))
(let ((first-node (get-item-by-id "http://test-tm/first-node"
:xtm-id document-id))
(first-type (get-item-by-id "http://test-tm/first-type"
@@ -1472,8 +1474,8 @@
2))
(rdf-importer::import-dom rdf-node revision-1 :tm-id tm-id
:document-id document-id)
- (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 38))
- (is (= (length (elephant:get-instances-by-class 'd:AssociationC)) 10))
+ (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 40))
+ (is (= (length (elephant:get-instances-by-class 'd:AssociationC)) 12))
(setf rdf-importer::*current-xtm* document-id)
(is (= (length
(intersection
@@ -1482,7 +1484,7 @@
(list
(d:get-item-by-id (concatenate
'string
- constants::*rdf2tm-collection*)
+ constants::*rdf-nil*)
:xtm-id rdf-importer::*rdf-core-xtm*)
(d:get-item-by-psi constants::*type-instance-psi*)
(dotimes (iter 9)
@@ -1515,8 +1517,9 @@
constants:*type-instance-psi*))
(subject (d:get-item-by-psi constants::*rdf2tm-subject*))
(object (d:get-item-by-psi constants::*rdf2tm-object*))
- (collection (d:get-item-by-id
- constants::*rdf2tm-collection*)))
+ (rdf-first (d:get-item-by-psi constants:*rdf-first*))
+ (rdf-rest (d:get-item-by-psi constants:*rdf-rest*))
+ (rdf-nil (d:get-item-by-psi constants:*rdf-nil*)))
(is (= (length (d:psis first-node)) 1))
(is (string= (d:uri (first (d:psis first-node)))
"http://test-tm/first-node"))
@@ -1560,6 +1563,15 @@
(is (= (length (d:psis arc8)) 1))
(is (string= (d:uri (first (d:psis arc8)))
"http://test/arcs/arc8"))
+ (is (= (length (d:psis rdf-first)) 1))
+ (is (string= (d:uri (first (d:psis rdf-first)))
+ constants:*rdf-first*))
+ (is (= (length (d:psis rdf-rest)) 1))
+ (is (string= (d:uri (first (d:psis rdf-rest)))
+ constants:*rdf-rest*))
+ (is (= (length (d:psis rdf-nil)) 1))
+ (is (string= (d:uri (first (d:psis rdf-nil)))
+ constants:*rdf-nil*))
(is (= (length (elephant:get-instances-by-class 'd:OccurrenceC))
1))
(is (string= (d:charvalue (first (elephant:get-instances-by-class
@@ -1629,30 +1641,84 @@
(eql (d:instance-of (d:parent x)) arc4)))
(d:player-in-roles uuid-1))))))))
(is-true col-1)
- (is (= (length (d:player-in-roles col-1)) 2))
+ (is (= (length (d:player-in-roles col-1)) 3))
(is-true (find-if
#'(lambda(x)
(and (eql (d:instance-of x) subject)
(eql (d:instance-of (d:parent x))
- collection)))
+ rdf-first)))
(d:player-in-roles col-1)))
- (let ((col-assoc
- (d:parent
- (find-if
+ (is-true (find-if
#'(lambda(x)
(and (eql (d:instance-of x) subject)
(eql (d:instance-of (d:parent x))
- collection)))
- (d:player-in-roles col-1)))))
- (is-true col-assoc)
- (is (= (length (d:roles col-assoc)) 3))
- (is (= (count-if
+ rdf-rest)))
+ (d:player-in-roles col-1)))
+ (is-true (find-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) object)
+ (eql (d:instance-of (d:parent x))
+ arc4)))
+ (d:player-in-roles col-1)))
+ (is (= (length (d:player-in-roles item-1)) 1))
+ (is-true (find-if
#'(lambda(x)
(and (eql (d:instance-of x) object)
- (or (eql (d:player x) item-1)
- (eql (d:player x) item-2))))
- (d:roles col-assoc))
- 2))))
+ (eql (d:instance-of (d:parent x))
+ rdf-first)))
+ (d:player-in-roles item-1)))
+ (let ((col-2
+ (let ((role
+ (find-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) subject)
+ (eql (d:instance-of (d:parent x))
+ rdf-rest)))
+ (d:player-in-roles col-1))))
+ (is (= (length (d:roles (d:parent role))) 2))
+ (let ((other-role
+ (find-if #'(lambda(x)
+ (and (not (eql x role))
+ (eql (d:instance-of x)
+ object)))
+ (d:roles (d:parent role)))))
+ (d:player other-role)))))
+ (is-true col-2)
+ (is (= (length (d:psis col-2)) 0))
+ (is (= (length (d:player-in-roles col-2)) 3))
+ (is-true (find-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) subject)
+ (eql (d:instance-of (d:parent x))
+ rdf-first)))
+ (d:player-in-roles col-2)))
+ (is-true (find-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) subject)
+ (eql (d:instance-of (d:parent x))
+ rdf-rest)))
+ (d:player-in-roles col-2)))
+ (let ((col-3
+ (let ((role
+ (find-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) subject)
+ (eql (d:instance-of (d:parent x))
+ rdf-rest)))
+ (d:player-in-roles col-2))))
+
+ (is (= (length (d:roles (d:parent role))) 2))
+ (let ((other-role
+ (find-if
+ #'(lambda(x)
+ (not (eql x role)))
+ (d:roles (d:parent role)))))
+ (d:player other-role)))))
+ (is-true col-3)
+ (is (= (length (d:psis col-3)) 1))
+ (is (string= (d:uri (first (d:psis col-3)))
+ constants:*rdf-nil*))
+ (is (= (length (d:player-in-roles col-3)) 2)))))
(is (= (length (d:player-in-roles item-1)) 1))
(is (= (length (d:player-in-roles item-2)) 2))
(is-true (find-if
@@ -1689,12 +1755,13 @@
4))
(is (= (length (d:player-in-roles fourth-node)) 1))
(is (= (length (d:player-in-roles fifth-node)) 1))
+ (format t "--->")
(let ((col-2
(d:player
(find-if
#'(lambda(y)
(and (eql (d:instance-of y) object)
- (= 0 (length (d:psis (d:player y))))))
+ (= 1 (length (d:psis (d:player y))))))
(d:roles
(d:parent
(find-if
@@ -1702,24 +1769,11 @@
(and (eql (d:instance-of x) subject)
(eql (d:instance-of (d:parent x)) arc8)))
(d:player-in-roles uuid-2))))))))
+ (is (= (length (d:psis col-2)) 1))
+ (is (string= constants:*rdf-nil*
+ (d:uri (first (d:psis col-2)))))
(is-true col-2)
- (is (= (length (d:player-in-roles col-2)) 2))
- (is-true (find-if
- #'(lambda(x)
- (and (eql (d:instance-of x) subject)
- (eql (d:instance-of (d:parent x))
- collection)))
- (d:player-in-roles col-2)))
- (let ((col-assoc
- (d:parent
- (find-if
- #'(lambda(x)
- (and (eql (d:instance-of x) subject)
- (eql (d:instance-of (d:parent x))
- collection)))
- (d:player-in-roles col-2)))))
- (is-true col-assoc)
- (is (= (length (d:roles col-assoc)) 1))))))))))
+ (is (= (length (d:player-in-roles col-2)) 2)))))))))
(elephant:close-store))
@@ -1742,7 +1796,7 @@
(date "http://www.w3.org/2001/XMLSchema#date")
(de (d:get-item-by-id "http://isidorus/rdf2tm_mapping/scope#de"))
(long "http://www.w3.org/2001/XMLSchema#unsignedLong"))
- (is (= (length topics) 66))
+ (is (= (length topics) 65))
(is (= (length occs) 23))
(is (= (length assocs) 30))
(is-true de)
@@ -2350,9 +2404,7 @@
(zauberlehrling "http://some.where/poem/Der_Zauberlehrling")
(prometheus "http://some.where/poem/Prometheus")
(erlkoenig "http://some.where/ballad/Der_Erlkoenig")
- (country "http://some.where/types/Country")
-
- )
+ (country "http://some.where/types/Country"))
(is (= (count-if
#'(lambda(x)
(and (eql (d:instance-of x) supertype-subtype)
@@ -2708,6 +2760,227 @@
6))))))
+(test test-empty-collection
+ "Tests importing of empty collections."
+ (let ((db-dir "data_base")
+ (tm-id "http://test-tm/")
+ (revision-1 100)
+ (document-id "doc-id")
+ (doc-1
+ (concatenate 'string "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" "
+ "xmlns:arcs=\"http://test/arcs/\">"
+ " <rdf:Description rdf:about=\"first-node\">"
+ " <arcs:arc rdf:parseType=\"Collection\" />"
+ " </rdf:Description>"
+ "</rdf:RDF>")))
+ (let ((rdf-node (elt (dom:child-nodes
+ (cxml:parse doc-1 (cxml-dom:make-dom-builder)))
+ 0)))
+ (is-true rdf-node)
+ (rdf-init-db :db-dir db-dir :start-revision revision-1)
+ (rdf-importer::import-dom rdf-node revision-1 :tm-id tm-id
+ :document-id document-id)
+ (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 21))
+ (is (= (length (elephant:get-instances-by-class 'd:AssociationC)) 1))
+ (is (= (length (elephant:get-instances-by-class 'd:OccurrenceC)) 0))
+ (is (= (length (elephant:get-instances-by-class 'd:NameC)) 0))
+ (let ((first-node (d:get-item-by-id "http://test-tm/first-node"
+ :xtm-id document-id))
+ (arc (d:get-item-by-id "http://test/arcs/arc"
+ :xtm-id document-id))
+ (rdf-nil (d:get-item-by-id constants:*rdf-nil*
+ :xtm-id document-id))
+ (subject (d:get-item-by-id constants:*rdf2tm-subject*))
+ (object (d:get-item-by-id constants:*rdf2tm-object*)))
+ (is-true subject)
+ (is-true object)
+ (is-true first-node)
+ (is (= (length (d:psis first-node)) 1))
+ (is (string= (d:uri (first (d:psis first-node)))
+ "http://test-tm/first-node"))
+ (is-true arc)
+ (is (= (length (d:psis arc)) 1))
+ (is (string= (d:uri (first (d:psis arc)))
+ "http://test/arcs/arc"))
+ (is-true rdf-nil)
+ (is (= (length (d:psis rdf-nil)) 1))
+ (is (string= (d:uri (first (d:psis rdf-nil))) constants:*rdf-nil*))
+ (is (= (length (d:player-in-roles first-node)) 1))
+ (is (= (length (d:player-in-roles arc)) 0))
+ (is (= (length (d:player-in-roles rdf-nil)) 1))
+ (is-true (find-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) subject)
+ (eql (d:instance-of (d:parent x)) arc)))
+ (d:player-in-roles first-node)))
+ (is-true (find-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) object)
+ (eql (d:instance-of (d:parent x)) arc)))
+ (d:player-in-roles rdf-nil)))))))
+
+
+(test test-collection
+ "Tests importing of non-empty collections."
+ (let ((db-dir "data_base")
+ (tm-id "http://test-tm/")
+ (revision-1 100)
+ (document-id "doc-id")
+ (doc-1
+ (concatenate 'string "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" "
+ "xmlns:arcs=\"http://test/arcs/\">"
+ " <rdf:Description rdf:about=\"first-node\">"
+ " <arcs:arc rdf:parseType=\"Collection\">"
+ " <rdf:Description rdf:about=\"item-1\"/>"
+ " <arcs:Node rdf:about=\"item-2\"/>"
+ " </arcs:arc>"
+ " </rdf:Description>"
+ "</rdf:RDF>")))
+ (let ((rdf-node (elt (dom:child-nodes
+ (cxml:parse doc-1 (cxml-dom:make-dom-builder)))
+ 0)))
+ (is-true rdf-node)
+ (rdf-init-db :db-dir db-dir :start-revision revision-1)
+ (rdf-importer::import-dom rdf-node revision-1 :tm-id tm-id
+ :document-id document-id)
+ (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 28))
+ (is (= (length (elephant:get-instances-by-class 'd:AssociationC)) 6))
+ (is (= (length (elephant:get-instances-by-class 'd:OccurrenceC)) 0))
+ (is (= (length (elephant:get-instances-by-class 'd:NameC)) 0))
+ (let ((first-node (d:get-item-by-id "http://test-tm/first-node"
+ :xtm-id document-id))
+ (arc (d:get-item-by-id "http://test/arcs/arc"
+ :xtm-id document-id))
+ (item-1 (d:get-item-by-id "http://test-tm/item-1"
+ :xtm-id document-id))
+ (item-2 (d:get-item-by-id "http://test-tm/item-2"
+ :xtm-id document-id))
+ (node (d:get-item-by-id "http://test/arcs/Node"
+ :xtm-id document-id))
+ (rdf-first (d:get-item-by-id constants:*rdf-first*
+ :xtm-id document-id))
+ (rdf-rest (d:get-item-by-id constants:*rdf-rest*
+ :xtm-id document-id))
+ (rdf-nil (d:get-item-by-id constants:*rdf-nil*
+ :xtm-id document-id))
+ (subject (d:get-item-by-id constants:*rdf2tm-subject*
+ :xtm-id document-id))
+ (object (d:get-item-by-id constants:*rdf2tm-object*
+ :xtm-id document-id))
+ (instance (d:get-item-by-psi constants:*instance-psi*))
+ (type (d:get-item-by-psi constants:*type-psi*))
+ (type-instance (d:get-item-by-psi constants:*type-instance-psi*)))
+ (is-true first-node)
+ (is (= (length (d:psis first-node)) 1))
+ (is (string= (d:uri (first (d:psis first-node)))
+ "http://test-tm/first-node"))
+ (is (= (length (d:player-in-roles first-node)) 1))
+ (is-true arc)
+ (is (= (length (d:psis arc)) 1))
+ (is (string= (d:uri (first (d:psis arc)))
+ "http://test/arcs/arc"))
+ (is (= (length (d:player-in-roles arc)) 0))
+ (is-true item-1)
+ (is (= (length (d:psis item-1)) 1))
+ (is (string= (d:uri (first (d:psis item-1)))
+ "http://test-tm/item-1"))
+ (is (= (length (d:player-in-roles item-1)) 1))
+ (is-true item-2)
+ (is (= (length (d:psis item-2)) 1))
+ (is (string= (d:uri (first (d:psis item-2)))
+ "http://test-tm/item-2"))
+ (is (= (length (d:player-in-roles item-2)) 2))
+ (is-true node)
+ (is (= (length (d:psis node)) 1))
+ (is (string= (d:uri (first (d:psis node)))
+ "http://test/arcs/Node"))
+ (is (= (length (d:player-in-roles node)) 1))
+ (is-true rdf-first)
+ (is-true rdf-rest)
+ (is-true rdf-nil)
+ (is (= (length (d:player-in-roles rdf-nil)) 1))
+ (is-true subject)
+ (is-true object)
+ (let ((uuid-1
+ (d:player
+ (find-if
+ #'(lambda(x)
+ (not (eql x (first (d:player-in-roles first-node)))))
+ (d:roles (d:parent (first (d:player-in-roles first-node)))))))
+ (uuid-2
+ (d:player
+ (find-if
+ #'(lambda(x)
+ (not (eql x (first (d:player-in-roles rdf-nil)))))
+ (d:roles (d:parent (first (d:player-in-roles rdf-nil))))))))
+ (is-true uuid-1)
+ (is (= (length (d:psis uuid-1)) 0))
+ (is (= (length (d:player-in-roles uuid-1)) 3))
+ (is-true uuid-2)
+ (is (= (length (d:psis uuid-2)) 0))
+ (is (= (length (d:player-in-roles uuid-2)) 3))
+ (is-true (find-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) subject)
+ (eql (d:instance-of (d:parent x)) arc)))
+ (d:player-in-roles first-node)))
+ (is-true (find-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) object)
+ (eql (d:instance-of (d:parent x)) arc)))
+ (d:player-in-roles uuid-1)))
+ (is-true (find-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) subject)
+ (eql (d:instance-of (d:parent x)) rdf-first)))
+ (d:player-in-roles uuid-1)))
+ (is-true (find-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) subject)
+ (eql (d:instance-of (d:parent x)) rdf-rest)))
+ (d:player-in-roles uuid-1)))
+ (is-true (find-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) object)
+ (eql (d:instance-of (d:parent x)) rdf-first)))
+ (d:player-in-roles item-1)))
+ (is-true (find-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) object)
+ (eql (d:instance-of (d:parent x)) rdf-rest)))
+ (d:player-in-roles uuid-2)))
+ (is-true (find-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) subject)
+ (eql (d:instance-of (d:parent x)) rdf-first)))
+ (d:player-in-roles uuid-2)))
+ (is-true (find-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) subject)
+ (eql (d:instance-of (d:parent x)) rdf-rest)))
+ (d:player-in-roles uuid-2)))
+ (is-true (find-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) object)
+ (eql (d:instance-of (d:parent x)) rdf-rest)))
+ (d:player-in-roles rdf-nil)))
+ (is-true (find-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) object)
+ (eql (d:instance-of (d:parent x)) rdf-first)))
+ (d:player-in-roles item-2)))
+ (is-true (find-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) instance)
+ (eql (d:instance-of (d:parent x)) type-instance)))
+ (d:player-in-roles item-2)))
+ (is-true (find-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) type)
+ (eql (d:instance-of (d:parent x)) type-instance)))
+ (d:player-in-roles node))))))))
+
+
(defun run-rdf-importer-tests()
(when elephant:*store-controller*
(elephant:close-store))
@@ -2726,4 +2999,6 @@
(it.bese.fiveam:run! 'test-poems-rdf-occurrences)
(it.bese.fiveam:run! 'test-poems-rdf-associations)
(it.bese.fiveam:run! 'test-poems-rdf-typing)
- (it.bese.fiveam:run! 'test-poems-rdf-topics))
\ No newline at end of file
+ (it.bese.fiveam:run! 'test-poems-rdf-topics)
+ (it.bese.fiveam:run! 'test-empty-collection)
+ (it.bese.fiveam:run! 'test-collection))
\ 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 Thu Aug 13 15:47:53 2009
@@ -101,8 +101,6 @@
(format t ">> import-node: ~a <<~%" (dom:node-name elem)) ;TODO: remove
(tm-id-p tm-id "import-node")
(parse-node elem)
- ;TODO: handle Collections that are made manually without
- ; parseType="Collection" -> see also import-arc
(let ((fn-xml-base (get-xml-base elem :old-base xml-base))
(fn-xml-lang (get-xml-lang elem :old-lang xml-lang)))
(let ((about (get-absolute-attribute elem tm-id xml-base "about"))
@@ -158,76 +156,123 @@
(let ((fn-xml-lang (get-xml-lang elem :old-lang xml-lang))
(fn-xml-base (get-xml-base elem :old-base xml-base))
(UUID (get-ns-attribute elem "UUID" :ns-uri *rdf2tm-ns*))
- (parseType (get-ns-attribute elem "parseType")))
- (when (or (not parseType)
- (and parseType
- (string/= parseType "Collection")))
- (when UUID
- (parse-properties-of-node elem UUID)
- (with-tm (start-revision document-id tm-id)
- (let ((this (get-item-by-id UUID :xtm-id document-id
- :revision start-revision)))
- (let ((literals (append (get-literals-of-property elem fn-xml-lang)
- (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
- (get-types-of-node-content elem tm-id fn-xml-base)
- (when (get-ns-attribute elem "type")
- (list :ID nil
- :topicid (get-ns-attribute elem "type")
- :psi (get-ns-attribute elem "type"))))))
- (super-classes
- (get-super-classes-of-node-content elem tm-id xml-base)))
- (make-literals this literals tm-id start-revision
- :document-id document-id)
- (make-associations this associations xml-importer::tm
- start-revision :document-id document-id)
- (make-types this types xml-importer::tm start-revision
- :document-id document-id)
- (make-super-classes this super-classes xml-importer::tm
- start-revision :document-id document-id))))))
- (make-recursion-from-arc elem tm-id start-revision
- :document-id document-id
- :xml-base xml-base :xml-lang xml-lang)))
+ (parseType (get-ns-attribute elem "parseType"))
+ (content (child-nodes-or-text elem :trim t)))
+ (with-tm (start-revision document-id tm-id)
+ (if (and (string= parseType "Collection")
+ (= (length content) 0))
+ (make-topic-stub *rdf-nil* nil nil nil start-revision
+ xml-importer::tm :document-id document-id)
+ (let ((this-topic
+ (when (or (not parseType)
+ (and parseType
+ (string/= parseType "Collection")))
+ (when UUID
+ (parse-properties-of-node elem UUID)
+ (let ((this
+ (get-item-by-id UUID :xtm-id document-id
+ :revision start-revision)))
+ (let ((literals
+ (append (get-literals-of-property
+ elem fn-xml-lang)
+ (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
+ (get-types-of-node-content elem tm-id fn-xml-base)
+ (when (get-ns-attribute elem "type")
+ (list :ID nil
+ :topicid (get-ns-attribute elem "type")
+ :psi (get-ns-attribute elem "type"))))))
+ (super-classes
+ (get-super-classes-of-node-content
+ elem tm-id xml-base)))
+ (make-literals this literals tm-id start-revision
+ :document-id document-id)
+ (make-associations this associations xml-importer::tm
+ start-revision :document-id document-id)
+ (make-types this types xml-importer::tm start-revision
+ :document-id document-id)
+ (make-super-classes
+ this super-classes xml-importer::tm
+ start-revision :document-id document-id))
+ this)))))
+ (make-recursion-from-arc elem tm-id start-revision
+ :document-id document-id
+ :xml-base xml-base :xml-lang xml-lang)
+ this-topic)))))
-(defun make-collection (elem owner-top tm-id start-revision
+(defun make-collection (elem tm-id start-revision
&key (document-id *document-id*)
(xml-base nil) (xml-lang nil))
- "Creates a TM association with a subject role containing the collection
- entry point and as many roles of the type 'object' as items exists."
- (declare (d:TopicC owner-top))
+ "Creates a collection structure of a node that contains
+ parseType='Collection."
+ (declare (dom:element elem))
(with-tm (start-revision document-id tm-id)
(let ((fn-xml-base (get-xml-base elem :old-base xml-base))
(fn-xml-lang (get-xml-lang elem :old-lang xml-lang))
- (subject (make-topic-stub *rdf2tm-subject* nil nil nil start-revision
- xml-importer::tm :document-id document-id))
- (object (make-topic-stub *rdf2tm-object* nil nil nil start-revision
- xml-importer::tm :document-id document-id)))
- (let ((association-type (make-topic-stub *rdf2tm-collection* nil nil nil
- start-revision xml-importer::tm
- :document-id document-id))
- (roles
- (append
- (loop for item across (child-nodes-or-text elem :trim t)
- collect (let ((item-top (import-node item tm-id start-revision
- :document-id document-id
- :xml-base fn-xml-base
- :xml-lang fn-xml-lang)))
- (list :player item-top
- :instance-of object)))
- (list (list :player owner-top
- :instance-of subject)))))
- (add-to-topicmap
- xml-importer::tm
- (make-construct 'd:AssociationC
- :start-revision start-revision
- :instance-of association-type
- :roles roles))))))
+ (UUID (get-ns-attribute elem "UUID" :ns-uri *rdf2tm-ns*)))
+ (let ((this (make-topic-stub nil nil nil UUID start-revision
+ xml-importer::tm
+ :document-id document-id))
+ (items (loop for item across (child-nodes-or-text elem :trim t)
+ collect (import-node item tm-id start-revision
+ :document-id document-id
+ :xml-base fn-xml-base
+ :xml-lang fn-xml-lang))))
+ (let ((last-blank-node this))
+ (dotimes (index (length items))
+ (let ((is-end
+ (if (= index (- (length items) 1))
+ t
+ nil)))
+ (let ((new-blank-node
+ (make-collection-association
+ last-blank-node (elt items index) tm-id start-revision
+ :is-end is-end :document-id document-id)))
+ (setf last-blank-node new-blank-node)))))))))
+
+
+(defun make-collection-association (current-blank-node first-object tm-id
+ start-revision &key (is-end nil)
+ (document-id *document-id*))
+ "Creates a 'first'-association between the current-blank-node and the
+ first-object. If is-end is set to true another association between
+ current-blank-node and the topic rdf:nil is created. Otherwise this
+ associaiton is made from the current-blank-node to a new created blank
+ node."
+ (declare (d:TopicC current-blank-node first-object))
+ (with-tm (start-revision document-id tm-id)
+ (let ((first-arc
+ (make-topic-stub *rdf-first* nil nil nil start-revision
+ xml-importer::tm :document-id document-id))
+ (rest-arc
+ (make-topic-stub *rdf-rest* nil nil nil start-revision
+ xml-importer::tm :document-id document-id)))
+ (make-association-with-nodes current-blank-node first-object first-arc
+ xml-importer::tm start-revision
+ :document-id document-id)
+ (if is-end
+ (let ((rdf-nil (make-topic-stub *rdf-nil* nil nil nil
+ start-revision xml-importer::tm
+ :document-id document-id)))
+ (make-association-with-nodes
+ current-blank-node rdf-nil rest-arc xml-importer::tm
+ start-revision :document-id document-id)
+ nil)
+ (let ((new-blank-node (make-topic-stub
+ nil nil nil (get-uuid) start-revision
+ xml-importer::tm :document-id document-id)))
+ (make-association-with-nodes
+ current-blank-node new-blank-node rest-arc xml-importer::tm
+ start-revision :document-id document-id)
+ new-blank-node)))))
(defun make-literals (owner-top literals tm-id start-revision
@@ -801,10 +846,15 @@
(not (and (string= prop-name "subClassOf")
(string= prop-ns *rdfs-ns*)))))
collect (let ((prop-xml-base (get-xml-base property
- :old-base fn-xml-base)))
+ :old-base fn-xml-base))
+ (content (child-nodes-or-text property :trim t))
+ (parseType (get-ns-attribute property "parseType")))
(let ((resource
- (get-absolute-attribute property tm-id
- fn-xml-base "resource"))
+ (if (and (string= parseType "Collection")
+ (= (length content) 0))
+ *rdf-nil*
+ (get-absolute-attribute property tm-id
+ fn-xml-base "resource")))
(nodeID (get-ns-attribute property "nodeID"))
(UUID (get-ns-attribute property "UUID"
:ns-uri *rdf2tm-ns*))
@@ -813,7 +863,7 @@
(full-name (get-type-of-node-name property)))
(if (or nodeID resource UUID)
(list :type full-name
- :topicid (or nodeID resource UUID)
+ :topicid (or resource nodeID UUID)
:psi resource
:ID ID)
(let ((refs (get-node-refs
@@ -851,8 +901,7 @@
(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))
- (parseType (get-ns-attribute arc "parseType"))
- (UUID (get-ns-attribute arc "UUID" :ns-uri *rdf2tm-ns*)))
+ (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"))
(resource (get-absolute-attribute arc tm-id xml-base "resource"))
@@ -860,32 +909,27 @@
(literals (get-literals-of-property arc xml-lang)))
(if (and parseType
(string= parseType "Collection"))
- (let ((this
- (with-tm (start-revision document-id tm-id)
- (make-topic-stub nil nil nil UUID start-revision
- xml-importer::tm
- :document-id document-id))))
- (make-collection arc this tm-id start-revision
- :document-id document-id
- :xml-base xml-base
- :xml-lang xml-lang))
+ (make-collection arc tm-id start-revision
+ :document-id document-id
+ :xml-base xml-base
+ :xml-lang xml-lang)
(if (or datatype resource nodeID
(and parseType
(string= parseType "Literal"))
(and content
(stringp content)))
- t;; do nothing current elem is a literal node that has been
- ;; already imported as an occurrence
+ nil;; do nothing current elem is a literal node that has been
+ ;; already imported as an occurrence
(if (or type literals
(and parseType
(string= parseType "Resource")))
(loop for item across content
- do (import-arc item tm-id start-revision
- :document-id document-id
- :xml-base fn-xml-base
- :xml-lang fn-xml-lang))
+ collect (import-arc item tm-id start-revision
+ :document-id document-id
+ :xml-base fn-xml-base
+ :xml-lang fn-xml-lang))
(loop for item across content
- do (import-node item tm-id start-revision
- :document-id document-id
- :xml-base xml-base
- :xml-lang xml-lang))))))))
+ collect (import-node item tm-id start-revision
+ :document-id document-id
+ :xml-base xml-base
+ :xml-lang xml-lang))))))))
\ No newline at end of file
Modified: trunk/src/xml/rdf/rdf_core_psis.xtm
==============================================================================
--- trunk/src/xml/rdf/rdf_core_psis.xtm (original)
+++ trunk/src/xml/rdf/rdf_core_psis.xtm Thu Aug 13 15:47:53 2009
@@ -23,13 +23,6 @@
<value>object</value>
</name>
</topic>
-
- <topic id="collection">
- <subjectIdentifier href="http://isidorus/rdf2tm_mapping#collection"/>
- <name>
- <value>object</value>
- </name>
- </topic>
<topic id="supertype-subtype">
<subjectIdentifier href="http://psi.topicmaps.org/iso13250/model/supertype-subtype"/>
Modified: trunk/src/xml/rdf/rdf_tools.lisp
==============================================================================
--- trunk/src/xml/rdf/rdf_tools.lisp (original)
+++ trunk/src/xml/rdf/rdf_tools.lisp Thu Aug 13 15:47:53 2009
@@ -31,7 +31,6 @@
*rdf-nil*
*rdf-first*
*rdf-rest*
- *rdf2tm-collection*
*rdf2tm-scope-prefix*)
(:import-from :xml-constants
*rdf_core_psis.xtm*)
1
0
Author: lgiessmann
Date: Mon Aug 10 06:48:58 2009
New Revision: 112
Log:
rdf-importer: fixed a problem with rdf:li, so distributed rdf:li elementes ar not merged. intead of merging names the names of the form rdf:_n are incremented across the entire document for the same resource. when the user mixes rdf:li elements and rdf:_n elements on one resource there is no separate handling, i.e.these elements are merged anyway.
Modified:
trunk/src/unit_tests/rdf_importer_test.lisp
trunk/src/xml/rdf/importer.lisp
trunk/src/xml/rdf/rdf_tools.lisp
Modified: trunk/src/unit_tests/rdf_importer_test.lisp
==============================================================================
--- trunk/src/unit_tests/rdf_importer_test.lisp (original)
+++ trunk/src/unit_tests/rdf_importer_test.lisp Mon Aug 10 06:48:58 2009
@@ -880,16 +880,18 @@
(is (= (length (dom:child-nodes dom-1))))
(let ((node (elt (dom:child-nodes dom-1) 0)))
(is-true (rdf-importer::parse-node node))
- (is-true (rdf-importer::parse-properties-of-node node))
- (is (= (length rdf-importer::*_n-map*) 8))
+ (is-true (rdf-importer::parse-properties-of-node
+ node "http://xml-base/first/resource"))
+ (is (= (length rdf-importer::*_n-map*) 1))
+ (is (= (length (getf (first rdf-importer::*_n-map*) :props)) 8))
(dotimes (iter (length rdf-importer::*_n-map*))
(is-true (find-if
#'(lambda(x)
- (string= (getf x :type)
+ (string= (getf x :name)
(concatenate
'string *rdf-ns* "_"
(write-to-string (+ 1 iter)))))
- rdf-importer::*_n-map*)))
+ (getf (first rdf-importer::*_n-map*) :props))))
(let ((assocs
(rdf-importer::get-associations-of-node-content node tm-id nil))
(content-literals
@@ -985,8 +987,7 @@
(getf x :ID)
"http://xml-base/first#rdfID-4")))
content-literals)))
- (rdf-importer::remove-node-properties-from-*_n-map* node)
- (is (= (length rdf-importer::*_n-map*) 0))))))
+ (setf rdf-importer::*_n-map* nil)))))
(test test-import-node-1
@@ -1741,7 +1742,7 @@
(date "http://www.w3.org/2001/XMLSchema#date")
(de (d:get-item-by-id "http://isidorus/rdf2tm_mapping/scope#de"))
(long "http://www.w3.org/2001/XMLSchema#unsignedLong"))
- (is (= (length topics) 65))
+ (is (= (length topics) 66))
(is (= (length occs) 23))
(is (= (length assocs) 30))
(is-true de)
@@ -2285,7 +2286,7 @@
#'(lambda(x)
(and (= (length (d:psis (d:instance-of x))) 1)
(string= (d:uri (first (d:psis (d:instance-of x))))
- (concatenate 'string constants:*rdf-ns* "_1"))
+ (concatenate 'string constants:*rdf-ns* "_2"))
(find-if
#'(lambda(y)
(and (eql (d:instance-of y) isi-subject)
@@ -2304,7 +2305,7 @@
#'(lambda(x)
(and (= (length (d:psis (d:instance-of x))) 1)
(string= (d:uri (first (d:psis (d:instance-of x))))
- (concatenate 'string constants:*rdf-ns* "_2"))
+ (concatenate 'string constants:*rdf-ns* "_3"))
(find-if
#'(lambda(y)
(and (eql (d:instance-of y) isi-subject)
@@ -2641,6 +2642,7 @@
(bag (get-item-by-id (concatenate 'string *rdf-ns* "Bag")))
(_1 (get-item-by-id (concatenate 'string *rdf-ns* "_1")))
(_2 (get-item-by-id (concatenate 'string *rdf-ns* "_2")))
+ (_3 (get-item-by-id (concatenate 'string *rdf-ns* "_3")))
(zauberlehrling
(get-item-by-id "http://some.where/poem/Der_Zauberlehrling"))
(poem (get-item-by-id (concatenate 'string types "Poem")))
@@ -2685,6 +2687,7 @@
(check-topic bag (concatenate 'string *rdf-ns* "Bag"))
(check-topic _1 (concatenate 'string *rdf-ns* "_1"))
(check-topic _2 (concatenate 'string *rdf-ns* "_2"))
+ (check-topic _3 (concatenate 'string *rdf-ns* "_3"))
(check-topic zauberlehrling "http://some.where/poem/Der_Zauberlehrling")
(check-topic poem (concatenate 'string types "Poem"))
(check-topic dateRange (concatenate 'string arcs "dateRange"))
Modified: trunk/src/xml/rdf/importer.lisp
==============================================================================
--- trunk/src/xml/rdf/importer.lisp (original)
+++ trunk/src/xml/rdf/importer.lisp Mon Aug 10 06:48:58 2009
@@ -105,12 +105,13 @@
; parseType="Collection" -> see also import-arc
(let ((fn-xml-base (get-xml-base elem :old-base xml-base))
(fn-xml-lang (get-xml-lang elem :old-lang xml-lang)))
- (parse-properties-of-node elem)
(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"))
- (UUID (get-ns-attribute elem "UUID" :ns-uri *rdf2tm-ns*))
- (literals (append (get-literals-of-node elem fn-xml-lang)
+ (UUID (get-ns-attribute elem "UUID" :ns-uri *rdf2tm-ns*)))
+ (parse-properties-of-node elem (or about nodeID ID UUID))
+
+ (let ((literals (append (get-literals-of-node elem fn-xml-lang)
(get-literals-of-node-content
elem tm-id xml-base fn-xml-lang)))
(associations (get-associations-of-node-content elem tm-id xml-base))
@@ -144,8 +145,7 @@
:document-id document-id
:xml-base xml-base
:xml-lang xml-lang)
- (remove-node-properties-from-*_n-map* elem)
- this))))))
+ this)))))))
(defun import-arc (elem tm-id start-revision
@@ -163,7 +163,7 @@
(and parseType
(string/= parseType "Collection")))
(when UUID
- (parse-properties-of-node elem)
+ (parse-properties-of-node elem UUID)
(with-tm (start-revision document-id tm-id)
(let ((this (get-item-by-id UUID :xtm-id document-id
:revision start-revision)))
Modified: trunk/src/xml/rdf/rdf_tools.lisp
==============================================================================
--- trunk/src/xml/rdf/rdf_tools.lisp (original)
+++ trunk/src/xml/rdf/rdf_tools.lisp Mon Aug 10 06:48:58 2009
@@ -108,53 +108,73 @@
(condition () nil))))))
-(defun set-_n-name (property _n-counter)
- "Returns a name of the form <rdf>_[1-9][0-9]* and adds a tupple
- of the form :elem <dom-elem> :type<<rdf>_[1-9][0-9]*> to the
- list *_n-map*.
- If the dom-elem is already contained in the list only the
- <rdf>_[1-9][0-9]* name is returned."
- (let ((map-item (find-if #'(lambda(x)
- (eql (getf x :elem) property))
- *_n-map*)))
- (if map-item
- (getf map-item :type)
- (let ((new-type-name
- (concatenate 'string *rdf-ns* "_" (write-to-string _n-counter))))
- (push (list :elem property
- :type new-type-name)
- *_n-map*)
- new-type-name))))
-
-
-(defun unset-_n-name (property)
- "Deletes the passed property tupple of the *_n-map* list."
- (setf *_n-map* (remove-if #'(lambda(x)
- (eql (getf x :elem) property))
- *_n-map*)))
+(defun find-_n-name-of-property (property)
+ "Returns the properties name of the form rdf:_n or nil."
+ (let ((owner
+ (find-if
+ #'(lambda(x)
+ (find-if
+ #'(lambda(y)
+ (eql (getf y :elem) property))
+ (getf x :props)))
+ *_n-map*)))
+ (let ((elem (find-if #'(lambda(x)
+ (eql (getf x :elem) property))
+ (getf owner :props))))
+ (when elem
+ (getf elem :name)))))
-(defun remove-node-properties-from-*_n-map* (node)
- "Removes all node's properties from the list *_n-map*."
- (declare (dom:element node))
- (let ((properties (child-nodes-or-text node :trim t)))
- (when properties
- (loop for property across properties
- do (unset-_n-name property))))
- (dom:map-node-map
- #'(lambda(attr) (unset-_n-name attr))
- (dom:attributes node)))
+
+
+(defun find-_n-name (owner-identifier property)
+ "Returns a name of the form rdf:_n of the property element
+ when it owns the tagname rdf:li and exists in the *_n-map* list.
+ Otherwise the return value is nil."
+ (let ((owner (find-if #'(lambda(x)
+ (string= (getf x :owner) owner-identifier))
+ *_n-map*)))
+ (when owner
+ (let ((prop (find-if #'(lambda(x)
+ (eql (getf x :elem) property))
+ (getf owner :props))))
+ (getf prop :name)))))
+
+
+(defun set-_n-name (owner-identifier property)
+ "Sets a new name of the form _n for the passed property element and
+ adds it to the list *_n-map*. If the property already exists in the
+ *_n-map* list, there won't be created a new entry but returned the
+ stored value name."
+ (let ((name (find-_n-name owner-identifier property)))
+ (if name
+ name
+ (let ((owner (find-if #'(lambda(x)
+ (string= (getf x :owner) owner-identifier))
+ *_n-map*)))
+ (if owner
+ (let ((new-name
+ (concatenate
+ 'string *rdf-ns* "_"
+ (write-to-string (+ (length (getf owner :props)) 1)))))
+ (push (list :elem property
+ :name new-name)
+ (getf owner :props))
+ new-name)
+ (progn
+ (push
+ (list :owner owner-identifier
+ :props (list
+ (list :elem property
+ :name (concatenate 'string *rdf-ns* "_1"))))
+ *_n-map*)
+ "_1"))))))
(defun get-type-of-node-name (node)
- "Returns the type of the node name (namespace + tagname).
- When the node is contained in *_n-map* the corresponding
- value of this map will be returned."
- (let ((map-item (find-if #'(lambda(x)
- (eql (getf x :elem) node))
- *_n-map*)))
+ (let ((map-item (find-_n-name-of-property node)))
(if map-item
- (getf map-item :type)
+ map-item
(let ((node-name (get-node-name node))
(node-ns (dom:namespace-uri node)))
(concatenate-uri node-ns node-name)))))
@@ -258,7 +278,7 @@
:psi (or ID about)))))))
-(defun parse-property-name (property _n-counter)
+(defun parse-property-name (property owner-identifier)
"Parses the given property's name to the known rdf/rdfs nodes and arcs.
If the given name es equal to an node an error is thrown otherwise
there is displayed a warning when the rdf ord rdfs namespace is used."
@@ -286,11 +306,12 @@
err-pref property-name)))
(when (and (string= property-ns *rdf-ns*)
(string= property-name "li"))
- (set-_n-name property _n-counter)))
+ (set-_n-name owner-identifier property)))
+ ;(set-_n-name property _n-counter)))
t)
-(defun parse-property (property _n-counter)
+(defun parse-property (property owner-identifier)
"Parses a property that represents a rdf-arc."
(declare (dom:element property))
(let ((err-pref "From parse-property(): ")
@@ -305,7 +326,7 @@
(subClassOf (get-ns-attribute property "subClassOf" :ns-uri *rdfs-ns*))
(literals (get-literals-of-property property nil))
(content (child-nodes-or-text property :trim t)))
- (parse-property-name property _n-counter)
+ (parse-property-name property owner-identifier)
(when (and parseType
(or nodeID resource datatype type literals))
(error "~awhen rdf:parseType is set the attributes: ~a => ~a are not allowed!"
@@ -382,7 +403,7 @@
(string= node-ns *rdfs-ns*)))
(and (> (length content) 0)
(stringp content)))
- (error "~awhen ~a not allowed to own literal content: ~a!"
+ (error "~awhen property is ~a literal content is not allowed: ~a!"
err-pref (if (string= node-name "type")
"rdf:type"
"rdfs:subClassOf")
@@ -398,28 +419,22 @@
t)
-(defun parse-properties-of-node (node)
+(defun parse-properties-of-node (node owner-identifier)
"Parses all node's properties by calling the parse-propery
function and sets all rdf:li properties as a tupple to the
*_n-map* list."
- (let ((child-nodes (child-nodes-or-text node :trim t))
- (_n-counter 0))
+ (let ((child-nodes (child-nodes-or-text node :trim t)))
+ ;(_n-counter 0))
(when (get-ns-attribute node "li")
(dom:map-node-map
#'(lambda(attr)
(when (and (string= (get-node-name attr) "li")
(string= (dom:namespace-uri attr) *rdf-ns*))
- (incf _n-counter)
- (set-_n-name attr _n-counter)))
+ (set-_n-name owner-identifier attr)))
(dom:attributes node)))
(when child-nodes
(loop for property across child-nodes
- do (let ((prop-name (get-node-name property))
- (prop-ns (dom:namespace-uri node)))
- (when (and (string= prop-name "li")
- (string= prop-ns *rdf-ns*))
- (incf _n-counter))
- (parse-property property _n-counter)))))
+ do (parse-property property owner-identifier))))
t)
1
0
Author: lgiessmann
Date: Fri Aug 7 11:48:40 2009
New Revision: 111
Log:
finalized the unit tests for poems.rdf
Modified:
trunk/src/constants.lisp
trunk/src/unit_tests/poems.rdf
trunk/src/unit_tests/poems_light.rdf
trunk/src/unit_tests/rdf_importer_test.lisp
trunk/src/xml/rdf/importer.lisp
trunk/src/xml/rdf/rdf_tools.lisp
Modified: trunk/src/constants.lisp
==============================================================================
--- trunk/src/constants.lisp (original)
+++ trunk/src/constants.lisp Fri Aug 7 11:48:40 2009
@@ -37,7 +37,8 @@
:*rdf-rest*
:*rdf2tm-object*
:*rdf2tm-subject*
- :*rdf2tm-collection*))
+ :*rdf2tm-collection*
+ :*rdf2tm-scope-prefix*))
(in-package :constants)
(defparameter *xtm2.0-ns* "http://www.topicmaps.org/xtm/")
@@ -94,4 +95,6 @@
(defparameter *rdf2tm-subject* "http://isidorus/rdf2tm_mapping#subject")
-(defparameter *rdf2tm-collection* "http://isidorus/rdf2tm_mapping#collection")
\ No newline at end of file
+(defparameter *rdf2tm-collection* "http://isidorus/rdf2tm_mapping#collection")
+
+(defparameter *rdf2tm-scope-prefix* "http://isidorus/rdf2tm_mapping/scope#")
\ No newline at end of file
Modified: trunk/src/unit_tests/poems.rdf
==============================================================================
--- trunk/src/unit_tests/poems.rdf (original)
+++ trunk/src/unit_tests/poems.rdf Fri Aug 7 11:48:40 2009
@@ -16,7 +16,7 @@
<types:Event>
<arcs:date rdf:datatype="http://www.w3.org/2001/XMLSchema#date">28.08.1749</arcs:date>
<arcs:place>
- <rdf:Description rdf:about="/region/FrankfurtMain">
+ <rdf:Description rdf:about="/metropolis/FrankfurtMain">
<rdf:type>
<rdf:Description rdf:about="/types/Metropolis">
<rdfs:subClassOf rdf:resource="/types/Region"/>
@@ -33,7 +33,7 @@
<arcs:population rdf:datatype="http://www.w3.org/2001/XMLSchema#unsignedLong">82099232</arcs:population>
<arcs:officialese rdf:resource="language/German"/>
<arcs:capital>
- <rdf:Description rdf:about="http://some.where/region/Berlin">
+ <rdf:Description rdf:about="http://some.where/metropolis/Berlin">
<rdf:type>
<rdf:Description rdf:about="http://some.where/types/Metropolis"/>
</rdf:type>
@@ -54,9 +54,9 @@
<rdf:type rdf:resource="Event"/>
<arcs:date rdf:datatype="#date" xml:base="http://www.w3.org/2001/XMLSchema">22.03.1832</arcs:date>
<arcs:place xml:base="">
- <types:City rdf:about="Weimar" arcs:fullName="Weimar">
+ <types:City rdf:about="http://some.where/city/Weimar" arcs:fullName="Weimar">
<rdfs:subClassOf rdf:resource="http://some.where/types/Region"/>
- <arcs:population rdf:datatype="http://www.w3.org/2001/XMLSchema#unsigneLong">64720</arcs:population>
+ <arcs:population rdf:datatype="http://www.w3.org/2001/XMLSchema#unsignedLong">64720</arcs:population>
<arcs:locatedIn rdf:resource="http://some.where/country/Germany"/>
</types:City>
</arcs:place>
Modified: trunk/src/unit_tests/poems_light.rdf
==============================================================================
--- trunk/src/unit_tests/poems_light.rdf (original)
+++ trunk/src/unit_tests/poems_light.rdf Fri Aug 7 11:48:40 2009
@@ -16,7 +16,7 @@
<types:Event>
<arcs:date rdf:datatype="http://www.w3.org/2001/XMLSchema#date">28.08.1749</arcs:date>
<arcs:place>
- <rdf:Description rdf:about="/region/FrankfurtMain">
+ <rdf:Description rdf:about="/metropolis/FrankfurtMain">
<rdf:type>
<rdf:Description rdf:about="/types/Metropolis">
<rdfs:subClassOf rdf:resource="/types/Region"/>
@@ -33,7 +33,7 @@
<arcs:population rdf:datatype="http://www.w3.org/2001/XMLSchema#unsignedLong">82099232</arcs:population>
<arcs:officialese rdf:resource="language/German"/>
<arcs:capital>
- <rdf:Description rdf:about="http://some.where/region/Berlin">
+ <rdf:Description rdf:about="http://some.where/metropolis/Berlin">
<rdf:type>
<rdf:Description rdf:about="http://some.where/types/Metropolis"/>
</rdf:type>
@@ -54,9 +54,9 @@
<rdf:type rdf:resource="Event"/>
<arcs:date rdf:datatype="#date" xml:base="http://www.w3.org/2001/XMLSchema">22.03.1832</arcs:date>
<arcs:place xml:base="">
- <types:City rdf:about="Weimar" arcs:fullName="Weimar">
+ <types:City rdf:about="http://some.where/city/Weimar" arcs:fullName="Weimar">
<rdfs:subClassOf rdf:resource="http://some.where/types/Region"/>
- <arcs:population rdf:datatype="http://www.w3.org/2001/XMLSchema#unsigneLong">64720</arcs:population>
+ <arcs:population rdf:datatype="http://www.w3.org/2001/XMLSchema#unsignedLong">64720</arcs:population>
<arcs:locatedIn rdf:resource="http://some.where/country/Germany"/>
</types:City>
</arcs:place>
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 Fri Aug 7 11:48:40 2009
@@ -55,7 +55,9 @@
:test-import-node-reification
:test-import-dom
:test-poems-rdf-occurrences
- :test-poems-rdf-associations))
+ :test-poems-rdf-associations
+ :test-poems-rdf-typing
+ :test-poems-rdf-topics))
(declaim (optimize (debug 3) (speed 0) (safety 3) (space 0) (compilation-speed 0)))
@@ -1728,17 +1730,31 @@
(occs (elephant:get-instances-by-class 'd:OccurrenceC))
(assocs (elephant:get-instances-by-class 'd:AssociationC))
(arcs "http://some.where/relationship/")
+ (goethe "http://some.where/author/Goethe")
+ (weimar "http://some.where/city/Weimar")
+ (berlin "http://some.where/metropolis/Berlin")
+ (frankfurt "http://some.where/metropolis/FrankfurtMain")
+ (germany "http://some.where/country/Germany")
+ (zauberlehrling "http://some.where/poem/Der_Zauberlehrling")
+ (prometheus "http://some.where/poem/Prometheus")
+ (erlkoenig "http://some.where/ballad/Der_Erlkoenig")
(date "http://www.w3.org/2001/XMLSchema#date")
+ (de (d:get-item-by-id "http://isidorus/rdf2tm_mapping/scope#de"))
(long "http://www.w3.org/2001/XMLSchema#unsignedLong"))
(is (= (length topics) 65))
(is (= (length occs) 23))
(is (= (length assocs) 30))
+ (is-true de)
(is (= (count-if
#'(lambda(x)
(and (= (length (d:psis (d:instance-of x))) 1)
(string= (d:uri (first (d:psis (d:instance-of x))))
(concatenate 'string arcs "firstName"))
- (string= *xml-string* (d:datatype x))))
+ (string= *xml-string* (d:datatype x))
+ (= (length (d:themes x)) 0)
+ (= (length (d:psis (d:topic x))) 1)
+ (string= (d:uri (first (d:psis (d:topic x))))
+ goethe)))
occs)
1))
(is (= (count-if
@@ -1746,7 +1762,11 @@
(and (= (length (d:psis (d:instance-of x))) 1)
(string= (d:uri (first (d:psis (d:instance-of x))))
(concatenate 'string arcs "lastName"))
- (string= *xml-string* (d:datatype x))))
+ (string= *xml-string* (d:datatype x))
+ (= (length (d:themes x)) 0)
+ (= (length (d:psis (d:topic x))) 1)
+ (string= (d:uri (first (d:psis (d:topic x))))
+ goethe)))
occs)
1))
(is (= (count-if
@@ -1754,15 +1774,61 @@
(and (= (length (d:psis (d:instance-of x))) 1)
(string= (d:uri (first (d:psis (d:instance-of x))))
(concatenate 'string arcs "fullName"))
- (string= *xml-string* (d:datatype x))))
+ (string= *xml-string* (d:datatype x))
+ (= (length (d:themes x)) 0)
+ (= (length (d:psis (d:topic x))) 1)
+ (string= (d:uri (first (d:psis (d:topic x))))
+ weimar)))
occs)
- 2))
+ 1))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (= (length (d:psis (d:instance-of x))) 1)
+ (string= (d:uri (first (d:psis (d:instance-of x))))
+ (concatenate 'string arcs "fullName"))
+ (string= *xml-string* (d:datatype x))
+ (= (length (d:themes x)) 0)
+ (= (length (d:psis (d:topic x))) 1)
+ (string= (d:uri (first (d:psis (d:topic x))))
+ frankfurt)))
+ occs)
+ 1))
(is (= (count-if
#'(lambda(x)
(and (= (length (d:psis (d:instance-of x))) 1)
(string= (d:uri (first (d:psis (d:instance-of x))))
(concatenate 'string arcs "nativeName"))
- (string= *xml-string* (d:datatype x))))
+ (string= *xml-string* (d:datatype x))
+ (= 1 (length (d:themes x)))
+ (eql (first (d:themes x)) de)
+ (= (length (d:psis (d:topic x))) 1)
+ (string= (d:uri (first (d:psis (d:topic x))))
+ germany)))
+ occs)
+ 1))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (= (length (d:psis (d:instance-of x))) 1)
+ (string= (d:uri (first (d:psis (d:instance-of x))))
+ (concatenate 'string arcs "title"))
+ (string= *xml-string* (d:datatype x))
+ (= 1 (length (d:themes x)))
+ (eql (first (d:themes x)) de)
+ (= (length (d:psis (d:topic x))) 1)
+ (string= (d:uri (first (d:psis (d:topic x))))
+ zauberlehrling)))
+ occs)
+ 1))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (= (length (d:psis (d:instance-of x))) 1)
+ (string= (d:uri (first (d:psis (d:instance-of x))))
+ (concatenate 'string arcs "title"))
+ (= 0 (length (d:themes x)))
+ (string= *xml-string* (d:datatype x))
+ (= (length (d:psis (d:topic x))) 1)
+ (string= (d:uri (first (d:psis (d:topic x))))
+ prometheus)))
occs)
1))
(is (= (count-if
@@ -1770,31 +1836,109 @@
(and (= (length (d:psis (d:instance-of x))) 1)
(string= (d:uri (first (d:psis (d:instance-of x))))
(concatenate 'string arcs "title"))
- (string= *xml-string* (d:datatype x))))
+ (string= *xml-string* (d:datatype x))
+ (= 1 (length (d:themes x)))
+ (eql (first (d:themes x)) de)
+ (= (length (d:psis (d:topic x))) 1)
+ (string= (d:uri (first (d:psis (d:topic x))))
+ erlkoenig)))
+ occs)
+ 1))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (= (length (d:psis (d:instance-of x))) 1)
+ (string= (d:uri (first (d:psis (d:instance-of x))))
+ (concatenate 'string arcs "content"))
+ (string= *xml-string* (d:datatype x))
+ (= 1 (length (d:themes x)))
+ (eql (first (d:themes x)) de)
+ (= (length (d:psis (d:topic x))) 1)
+ (string= (d:uri (first (d:psis (d:topic x))))
+ zauberlehrling)))
+ occs)
+ 1))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (= (length (d:psis (d:instance-of x))) 1)
+ (string= (d:uri (first (d:psis (d:instance-of x))))
+ (concatenate 'string arcs "content"))
+ (string= *xml-string* (d:datatype x))
+ (= 1 (length (d:themes x)))
+ (eql (first (d:themes x)) de)
+ (= (length (d:psis (d:topic x))) 1)
+ (string= (d:uri (first (d:psis (d:topic x))))
+ prometheus)))
occs)
- 3))
+ 1))
(is (= (count-if
#'(lambda(x)
(and (= (length (d:psis (d:instance-of x))) 1)
(string= (d:uri (first (d:psis (d:instance-of x))))
(concatenate 'string arcs "content"))
- (string= *xml-string* (d:datatype x))))
+ (string= *xml-string* (d:datatype x))
+ (= 1 (length (d:themes x)))
+ (eql (first (d:themes x)) de)
+ (= (length (d:psis (d:topic x))) 1)
+ (string= (d:uri (first (d:psis (d:topic x))))
+ erlkoenig)))
+ occs)
+ 1))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (= (length (d:psis (d:instance-of x))) 1)
+ (string= (d:uri (first (d:psis (d:instance-of x))))
+ (concatenate 'string arcs "population"))
+ (string= long (d:datatype x))
+ (= 0 (length (d:themes x)))
+ (= (length (d:psis (d:topic x))) 1)
+ (string= (d:uri (first (d:psis (d:topic x))))
+ weimar)))
+ occs)
+ 1))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (= (length (d:psis (d:instance-of x))) 1)
+ (string= (d:uri (first (d:psis (d:instance-of x))))
+ (concatenate 'string arcs "population"))
+ (string= long (d:datatype x))
+ (= 0 (length (d:themes x)))
+ (= (length (d:psis (d:topic x))) 1)
+ (string= (d:uri (first (d:psis (d:topic x))))
+ frankfurt)))
+ occs)
+ 1))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (= (length (d:psis (d:instance-of x))) 1)
+ (string= (d:uri (first (d:psis (d:instance-of x))))
+ (concatenate 'string arcs "population"))
+ (string= long (d:datatype x))
+ (= 0 (length (d:themes x)))
+ (= (length (d:psis (d:topic x))) 1)
+ (string= (d:uri (first (d:psis (d:topic x))))
+ berlin)))
occs)
- 3))
+ 1))
(is (= (count-if
#'(lambda(x)
(and (= (length (d:psis (d:instance-of x))) 1)
(string= (d:uri (first (d:psis (d:instance-of x))))
(concatenate 'string arcs "population"))
- (string= long (d:datatype x))))
+ (string= long (d:datatype x))
+ (= 0 (length (d:themes x)))
+ (= (length (d:psis (d:topic x))) 1)
+ (string= (d:uri (first (d:psis (d:topic x))))
+ germany)))
occs)
- 3))
+ 1))
(is (= (count-if
#'(lambda(x)
(and (= (length (d:psis (d:instance-of x))) 1)
(string= (d:uri (first (d:psis (d:instance-of x))))
(concatenate 'string arcs "date"))
- (string= date (d:datatype x))))
+ (string= date (d:datatype x))
+ (= 0 (length (d:themes x)))
+ (= (length (d:psis (d:topic x))) 0)))
occs)
2))
(is (= (count-if
@@ -1802,26 +1946,763 @@
(and (= (length (d:psis (d:instance-of x))) 1)
(string= (d:uri (first (d:psis (d:instance-of x))))
(concatenate 'string arcs "start"))
- (string= date (d:datatype x))))
+ (string= date (d:datatype x))
+ (= 1 (length (d:themes x)))
+ (eql (first (d:themes x)) de)
+ (= (length (d:psis (d:topic x))) 0)))
+
+ occs)
+ 1))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (= (length (d:psis (d:instance-of x))) 1)
+ (string= (d:uri (first (d:psis (d:instance-of x))))
+ (concatenate 'string arcs "start"))
+ (string= date (d:datatype x))
+ (= 0 (length (d:themes x)))
+ (= (length (d:psis (d:topic x))) 0)))
+
+ occs)
+ 2))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (= (length (d:psis (d:instance-of x))) 1)
+ (string= (d:uri (first (d:psis (d:instance-of x))))
+ (concatenate 'string arcs "end"))
+ (string= date (d:datatype x))
+ (= 1 (length (d:themes x)))
+ (eql (first (d:themes x)) de)
+ (= (length (d:psis (d:topic x))) 0)))
occs)
- 3))
+ 1))
(is (= (count-if
#'(lambda(x)
(and (= (length (d:psis (d:instance-of x))) 1)
(string= (d:uri (first (d:psis (d:instance-of x))))
(concatenate 'string arcs "end"))
- (string= date (d:datatype x))))
+ (string= date (d:datatype x))
+ (= 0 (length (d:themes x)))
+ (= (length (d:psis (d:topic x))) 0)))
occs)
- 3)))))
+ 2)))))
(test test-poems-rdf-associations
"Tests general functionality of the rdf-importer module with the file
poems_light.rdf."
(with-fixture rdf-test-db ()
+ (let ((assocs (elephant:get-instances-by-class 'd:AssociationC))
+ (isi-object (d:get-item-by-psi constants::*rdf2tm-object*))
+ (isi-subject (d:get-item-by-psi constants::*rdf2tm-subject*))
+ (arcs "http://some.where/relationship/")
+ (goethe "http://some.where/author/Goethe")
+ (germany "http://some.where/country/Germany")
+ (berlin "http://some.where/metropolis/Berlin")
+ (german "http://some.where/language/German")
+ (frankfurt "http://some.where/metropolis/FrankfurtMain")
+ (weimar "http://some.where/city/Weimar")
+ (zauberlehrling "http://some.where/poem/Der_Zauberlehrling")
+ (prometheus "http://some.where/poem/Prometheus")
+ (erlkoenig "http://some.where/ballad/Der_Erlkoenig"))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (= (length (d:psis (d:instance-of x))) 1)
+ (string= (d:uri (first (d:psis (d:instance-of x))))
+ (concatenate 'string arcs "born"))
+ (= (length (d:roles x)) 2)
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) isi-subject)
+ (= (length (d:psis (d:player y))) 1)
+ (string= (d:uri (first (d:psis (d:player y))))
+ goethe)))
+ (d:roles x))
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) isi-object)
+ (= (length (d:psis (d:player y))) 0)))
+ (d:roles x))))
+ assocs)
+ 1))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (= (length (d:psis (d:instance-of x))) 1)
+ (string= (d:uri (first (d:psis (d:instance-of x))))
+ (concatenate 'string arcs "died"))
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) isi-subject)
+ (= (length (d:psis (d:player y))) 1)
+ (string= (d:uri (first (d:psis (d:player y))))
+ goethe)))
+ (d:roles x))
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) isi-object)
+ (= (length (d:psis (d:player y))) 0)))
+ (d:roles x))))
+ assocs)
+ 1))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (= (length (d:psis (d:instance-of x))) 1)
+ (string= (d:uri (first (d:psis (d:instance-of x))))
+ (concatenate 'string arcs "wrote"))
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) isi-subject)
+ (= (length (d:psis (d:player y))) 1)
+ (string= (d:uri (first (d:psis (d:player y))))
+ goethe)))
+ (d:roles x))
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) isi-object)
+ (= (length (d:psis (d:player y))) 0)))
+ (d:roles x))))
+ assocs)
+ 1))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (= (length (d:psis (d:instance-of x))) 1)
+ (string= (d:uri (first (d:psis (d:instance-of x))))
+ (concatenate 'string arcs "capital"))
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) isi-subject)
+ (= (length (d:psis (d:player y))) 1)
+ (string= (d:uri (first (d:psis (d:player y))))
+ germany)))
+ (d:roles x))
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) isi-object)
+ (= (length (d:psis (d:player y))) 1)
+ (string= (d:uri (first (d:psis (d:player y))))
+ berlin)))
+ (d:roles x))))
+ assocs)
+ 1))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (= (length (d:psis (d:instance-of x))) 1)
+ (string= (d:uri (first (d:psis (d:instance-of x))))
+ (concatenate 'string arcs "officialese"))
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) isi-subject)
+ (= (length (d:psis (d:player y))) 1)
+ (string= (d:uri (first (d:psis (d:player y))))
+ germany)))
+ (d:roles x))
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) isi-object)
+ (= (length (d:psis (d:player y))) 1)
+ (string= (d:uri (first (d:psis (d:player y))))
+ german)))
+ (d:roles x))))
+ assocs)
+ 1))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (= (length (d:psis (d:instance-of x))) 1)
+ (string= (d:uri (first (d:psis (d:instance-of x))))
+ (concatenate 'string arcs "place"))
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) isi-object)
+ (= (length (d:psis (d:player y))) 1)
+ (string= (d:uri (first (d:psis (d:player y))))
+ frankfurt)))
+ (d:roles x))
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) isi-subject)
+ (= (length (d:psis (d:player y))) 0)))
+ (d:roles x))))
+ assocs)
+ 1))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (= (length (d:psis (d:instance-of x))) 1)
+ (string= (d:uri (first (d:psis (d:instance-of x))))
+ (concatenate 'string arcs "place"))
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) isi-object)
+ (= (length (d:psis (d:player y))) 1)
+ (string= (d:uri (first (d:psis (d:player y))))
+ weimar)))
+ (d:roles x))
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) isi-subject)
+ (= (length (d:psis (d:player y))) 0)))
+ (d:roles x))))
+ assocs)
+ 1))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (= (length (d:psis (d:instance-of x))) 1)
+ (string= (d:uri (first (d:psis (d:instance-of x))))
+ (concatenate 'string arcs "locatedIn"))
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) isi-subject)
+ (= (length (d:psis (d:player y))) 1)
+ (string= (d:uri (first (d:psis (d:player y))))
+ frankfurt)))
+ (d:roles x))
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) isi-object)
+ (= (length (d:psis (d:player y))) 1)
+ (string= (d:uri (first (d:psis (d:player y))))
+ germany)))
+ (d:roles x))))
+ assocs)
+ 1))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (= (length (d:psis (d:instance-of x))) 1)
+ (string= (d:uri (first (d:psis (d:instance-of x))))
+ (concatenate 'string arcs "locatedIn"))
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) isi-subject)
+ (= (length (d:psis (d:player y))) 1)
+ (string= (d:uri (first (d:psis (d:player y))))
+ weimar)))
+ (d:roles x))
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) isi-object)
+ (= (length (d:psis (d:player y))) 1)
+ (string= (d:uri (first (d:psis (d:player y))))
+ germany)))
+ (d:roles x))))
+ assocs)
+ 1))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (= (length (d:psis (d:instance-of x))) 1)
+ (string= (d:uri (first (d:psis (d:instance-of x))))
+ (concatenate 'string arcs "locatedIn"))
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) isi-subject)
+ (= (length (d:psis (d:player y))) 1)
+ (string= (d:uri (first (d:psis (d:player y))))
+ berlin)))
+ (d:roles x))
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) isi-object)
+ (= (length (d:psis (d:player y))) 1)
+ (string= (d:uri (first (d:psis (d:player y))))
+ germany)))
+ (d:roles x))))
+ assocs)
+ 1))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (= (length (d:psis (d:instance-of x))) 1)
+ (string= (d:uri (first (d:psis (d:instance-of x))))
+ (concatenate 'string arcs "dateRange"))
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) isi-subject)
+ (= (length (d:psis (d:player y))) 1)
+ (string= (d:uri (first (d:psis (d:player y))))
+ prometheus)))
+ (d:roles x))
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) isi-object)
+ (= (length (d:psis (d:player y))) 0)))
+ (d:roles x))))
+ assocs)
+ 1))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (= (length (d:psis (d:instance-of x))) 1)
+ (string= (d:uri (first (d:psis (d:instance-of x))))
+ (concatenate 'string arcs "dateRange"))
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) isi-subject)
+ (= (length (d:psis (d:player y))) 1)
+ (string= (d:uri (first (d:psis (d:player y))))
+ zauberlehrling)))
+ (d:roles x))
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) isi-object)
+ (= (length (d:psis (d:player y))) 0)))
+ (d:roles x))))
+ assocs)
+ 1))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (= (length (d:psis (d:instance-of x))) 1)
+ (string= (d:uri (first (d:psis (d:instance-of x))))
+ (concatenate 'string arcs "dateRange"))
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) isi-subject)
+ (= (length (d:psis (d:player y))) 1)
+ (string= (d:uri (first (d:psis (d:player y))))
+ erlkoenig)))
+ (d:roles x))
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) isi-object)
+ (= (length (d:psis (d:player y))) 0)))
+ (d:roles x))))
+ assocs)
+ 1))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (= (length (d:psis (d:instance-of x))) 1)
+ (string= (d:uri (first (d:psis (d:instance-of x))))
+ (concatenate 'string constants:*rdf-ns* "_1"))
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) isi-subject)
+ (= (length (d:psis (d:player y))) 0)))
+ (d:roles x))
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) isi-object)
+ (= (length (d:psis (d:player y))) 1)
+ (string= (d:uri (first (d:psis (d:player y))))
+ zauberlehrling)))
+ (d:roles x))))
+ assocs)
+ 1))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (= (length (d:psis (d:instance-of x))) 1)
+ (string= (d:uri (first (d:psis (d:instance-of x))))
+ (concatenate 'string constants:*rdf-ns* "_1"))
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) isi-subject)
+ (= (length (d:psis (d:player y))) 0)))
+ (d:roles x))
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) isi-object)
+ (= (length (d:psis (d:player y))) 1)
+ (string= (d:uri (first (d:psis (d:player y))))
+ erlkoenig)))
+ (d:roles x))))
+ assocs)
+ 1))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (= (length (d:psis (d:instance-of x))) 1)
+ (string= (d:uri (first (d:psis (d:instance-of x))))
+ (concatenate 'string constants:*rdf-ns* "_2"))
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) isi-subject)
+ (= (length (d:psis (d:player y))) 0)))
+ (d:roles x))
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) isi-object)
+ (= (length (d:psis (d:player y))) 1)
+ (string= (d:uri (first (d:psis (d:player y))))
+ prometheus)))
+ (d:roles x))))
+ assocs)
+ 1)))))
- ))
+(test test-poems-rdf-typing
+ "Tests general functionality of the rdf-importer module with the file
+ poems_light.rdf."
+ (with-fixture rdf-test-db ()
+ (let ((assocs (elephant:get-instances-by-class 'd:AssociationC))
+ (type (get-item-by-psi constants:*type-psi*))
+ (instance (get-item-by-psi constants:*instance-psi*))
+ (type-instance (get-item-by-psi constants:*type-instance-psi*))
+ (subtype (get-item-by-psi constants:*subtype-psi*))
+ (supertype (get-item-by-psi constants:*supertype-psi*))
+ (supertype-subtype
+ (get-item-by-psi constants:*supertype-subtype-psi*))
+ (region "http://some.where/types/Region")
+ (metropolis "http://some.where/types/Metropolis")
+ (city "http://some.where/types/City")
+ (frankfurt "http://some.where/metropolis/FrankfurtMain")
+ (weimar "http://some.where/city/Weimar")
+ (berlin "http://some.where/metropolis/Berlin")
+ (language "http://some.where/types/Language")
+ (german "http://some.where/language/German")
+ (author "http://some.where/types/Author")
+ (goethe "http://some.where/author/Goethe")
+ (bag (concatenate 'string constants::*rdf-ns* "Bag"))
+ (poem "http://some.where/types/Poem")
+ (ballad "http://some.where/types/Ballad")
+ (zauberlehrling "http://some.where/poem/Der_Zauberlehrling")
+ (prometheus "http://some.where/poem/Prometheus")
+ (erlkoenig "http://some.where/ballad/Der_Erlkoenig")
+ (country "http://some.where/types/Country")
+
+ )
+ (is (= (count-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) supertype-subtype)
+ (= (length (d:roles x)) 2)
+ (= (count-if
+ #'(lambda(y)
+ (or (eql (d:instance-of y) supertype)
+ (eql (d:instance-of y) subtype)))
+ (d:roles x)))))
+ assocs)))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) supertype-subtype)
+ (= (length (d:roles x)) 2)
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) supertype)
+ (= (length (d:psis (d:player y))) 1)
+ (string= (d:uri (first (d:psis (d:player y))))
+ region)))
+ (d:roles x))
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) subtype)
+ (= (length (d:psis (d:player y))) 1)
+ (string= (d:uri (first (d:psis (d:player y))))
+ metropolis)))
+ (d:roles x))))
+ assocs)))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) supertype-subtype)
+ (= (length (d:roles x)) 2)
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) supertype)
+ (= (length (d:psis (d:player y))) 1)
+ (string= (d:uri (first (d:psis (d:player y))))
+ region)))
+ (d:roles x))
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) subtype)
+ (= (length (d:psis (d:player y))) 1)
+ (string= (d:uri (first (d:psis (d:player y))))
+ city)))
+ (d:roles x))))
+ assocs)))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) type-instance)
+ (= (length (d:roles x)) 2)
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) type)
+ (= (length (d:psis (d:player y))) 1)
+ (string= (d:uri (first (d:psis (d:player y))))
+ metropolis)))
+ (d:roles x))
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) instance)
+ (= (length (d:psis (d:player y))) 1)
+ (string= (d:uri (first (d:psis (d:player y))))
+ frankfurt)))
+ (d:roles x))))
+ assocs)))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) type-instance)
+ (= (length (d:roles x)) 2)
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) type)
+ (= (length (d:psis (d:player y))) 1)
+ (string= (d:uri (first (d:psis (d:player y))))
+ metropolis)))
+ (d:roles x))
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) instance)
+ (= (length (d:psis (d:player y))) 1)
+ (string= (d:uri (first (d:psis (d:player y))))
+ berlin)))
+ (d:roles x))))
+ assocs)))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) type-instance)
+ (= (length (d:roles x)) 2)
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) type)
+ (= (length (d:psis (d:player y))) 1)
+ (string= (d:uri (first (d:psis (d:player y))))
+ city)))
+ (d:roles x))
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) instance)
+ (= (length (d:psis (d:player y))) 1)
+ (string= (d:uri (first (d:psis (d:player y))))
+ weimar)))
+ (d:roles x))))
+ assocs)))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) type-instance)
+ (= (length (d:roles x)) 2)
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) type)
+ (= (length (d:psis (d:player y))) 1)
+ (string= (d:uri (first (d:psis (d:player y))))
+ language)))
+ (d:roles x))
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) instance)
+ (= (length (d:psis (d:player y))) 1)
+ (string= (d:uri (first (d:psis (d:player y))))
+ german)))
+ (d:roles x))))
+ assocs)))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) type-instance)
+ (= (length (d:roles x)) 2)
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) type)
+ (= (length (d:psis (d:player y))) 1)
+ (string= (d:uri (first (d:psis (d:player y))))
+ bag)))
+ (d:roles x))
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) instance)
+ (= (length (d:psis (d:player y))) 0)))
+ (d:roles x))))
+ assocs)))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) type-instance)
+ (= (length (d:roles x)) 2)
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) type)
+ (= (length (d:psis (d:player y))) 1)
+ (string= (d:uri (first (d:psis (d:player y))))
+ author)))
+ (d:roles x))
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) instance)
+ (= (length (d:psis (d:player y))) 1)
+ (string= (d:uri (first (d:psis (d:player y))))
+ goethe)))
+ (d:roles x))))
+ assocs)))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) type-instance)
+ (= (length (d:roles x)) 2)
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) type)
+ (= (length (d:psis (d:player y))) 1)
+ (string= (d:uri (first (d:psis (d:player y))))
+ ballad)))
+ (d:roles x))
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) instance)
+ (= (length (d:psis (d:player y))) 1)
+ (string= (d:uri (first (d:psis (d:player y))))
+ erlkoenig)))
+ (d:roles x))))
+ assocs)))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) type-instance)
+ (= (length (d:roles x)) 2)
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) type)
+ (= (length (d:psis (d:player y))) 1)
+ (string= (d:uri (first (d:psis (d:player y))))
+ poem)))
+ (d:roles x))
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) instance)
+ (= (length (d:psis (d:player y))) 1)
+ (string= (d:uri (first (d:psis (d:player y))))
+ zauberlehrling)))
+ (d:roles x))))
+ assocs)))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) type-instance)
+ (= (length (d:roles x)) 2)
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) type)
+ (= (length (d:psis (d:player y))) 1)
+ (string= (d:uri (first (d:psis (d:player y))))
+ poem)))
+ (d:roles x))
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) instance)
+ (= (length (d:psis (d:player y))) 1)
+ (string= (d:uri (first (d:psis (d:player y))))
+ prometheus)))
+ (d:roles x))))
+ assocs)))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) type-instance)
+ (= (length (d:roles x)) 2)
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) type)
+ (= (length (d:psis (d:player y))) 1)
+ (string= (d:uri (first (d:psis (d:player y))))
+ country)))
+ (d:roles x))
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) instance)
+ (= (length (d:psis (d:player y))) 1)
+ (string= (d:uri (first (d:psis (d:player y))))
+ poem)))
+ (d:roles x))))
+ assocs))))))
+
+
+(defun check-topic (top psi)
+ "A simple helper for test-poems-rdf-topics."
+ (is-true top)
+ (is (= (length (d:psis top)) (if psi 1 0)))
+ (when psi
+ (is (string= (d:uri (first (d:psis top))) psi)))
+ (is (= (length (d:names top)) 0)))
+
+
+(test test-poems-rdf-topics
+ "Tests general functionality of the rdf-importer module with the file
+ poems_light.rdf."
+ (with-fixture rdf-test-db ()
+ (let ((arcs "http://some.where/relationship/")
+ (types "http://some.where/types/"))
+ (let ((goethe (get-item-by-id "http://some.where/author/Goethe"))
+ (author (get-item-by-id (concatenate 'string types "Author")))
+ (first-name (get-item-by-id
+ (concatenate 'string arcs "firstName")))
+ (last-name (get-item-by-id
+ (concatenate 'string arcs "lastName")))
+ (born (get-item-by-id (concatenate 'string arcs "born")))
+ (event (get-item-by-id (concatenate 'string types "Event")))
+ (date (get-item-by-id (concatenate 'string arcs "date")))
+ (place (get-item-by-id (concatenate 'string arcs "place")))
+ (frankfurt (get-item-by-id
+ "http://some.where/metropolis/FrankfurtMain"))
+ (metropolis (get-item-by-id (concatenate 'string types
+ "Metropolis")))
+ (region (get-item-by-id (concatenate 'string types "Region")))
+ (population (get-item-by-id (concatenate 'string arcs
+ "population")))
+ (locatedIn (get-item-by-id (concatenate 'string arcs
+ "locatedIn")))
+ (germany (get-item-by-id "http://some.where/country/Germany"))
+ (country (get-item-by-id (concatenate 'string types "Country")))
+ (native-name (get-item-by-id (concatenate 'string arcs
+ "nativeName")))
+ (officialese (get-item-by-id (concatenate 'string arcs
+ "officialese")))
+ (german (get-item-by-id "http://some.where/language/German"))
+ (capital (get-item-by-id (concatenate 'string arcs "capital")))
+ (berlin (get-item-by-id "http://some.where/metropolis/Berlin"))
+ (died (get-item-by-id (concatenate 'string arcs "died")))
+ (weimar (get-item-by-id "http://some.where/city/Weimar"))
+ (city (get-item-by-id (concatenate 'string types "City")))
+ (wrote (get-item-by-id (concatenate 'string arcs "wrote")))
+ (goethe-literature (get-item-by-id "goethe_literature"))
+ (bag (get-item-by-id (concatenate 'string *rdf-ns* "Bag")))
+ (_1 (get-item-by-id (concatenate 'string *rdf-ns* "_1")))
+ (_2 (get-item-by-id (concatenate 'string *rdf-ns* "_2")))
+ (zauberlehrling
+ (get-item-by-id "http://some.where/poem/Der_Zauberlehrling"))
+ (poem (get-item-by-id (concatenate 'string types "Poem")))
+ (dateRange (get-item-by-id (concatenate 'string arcs "dateRange")))
+ (start (get-item-by-id (concatenate 'string arcs "start")))
+ (end (get-item-by-id (concatenate 'string arcs "end")))
+ (title (get-item-by-id (concatenate 'string arcs "title")))
+ (content (get-item-by-id (concatenate 'string arcs "content")))
+ (erlkoenig (get-item-by-id "http://some.where/ballad/Der_Erlkoenig"))
+ (ballad (get-item-by-id (concatenate 'string types "Ballad")))
+ (de (get-item-by-id (concatenate
+ 'string constants::*rdf2tm-scope-prefix*
+ "de")))
+ (prometheus (get-item-by-id "http://some.where/poem/Prometheus"))
+ (language (get-item-by-id (concatenate 'string types "Language")))
+ (full-name (get-item-by-id (concatenate 'string arcs "fullName"))))
+ (check-topic goethe "http://some.where/author/Goethe")
+ (check-topic author (concatenate 'string types "Author"))
+ (check-topic first-name (concatenate 'string arcs "firstName"))
+ (check-topic last-name (concatenate 'string arcs "lastName"))
+ (check-topic born (concatenate 'string arcs "born"))
+ (check-topic event (concatenate 'string types "Event"))
+ (check-topic date (concatenate 'string arcs "date"))
+ (check-topic place (concatenate 'string arcs "place"))
+ (check-topic frankfurt "http://some.where/metropolis/FrankfurtMain")
+ (check-topic metropolis (concatenate 'string types "Metropolis"))
+ (check-topic region (concatenate 'string types "Region"))
+ (check-topic population (concatenate 'string arcs "population"))
+ (check-topic locatedIn (concatenate 'string arcs "locatedIn"))
+ (check-topic germany "http://some.where/country/Germany")
+ (check-topic country (concatenate 'string types "Country"))
+ (check-topic native-name (concatenate 'string arcs "nativeName"))
+ (check-topic officialese (concatenate 'string arcs "officialese"))
+ (check-topic german "http://some.where/language/German")
+ (check-topic capital (concatenate 'string arcs "capital"))
+ (check-topic berlin "http://some.where/metropolis/Berlin")
+ (check-topic died (concatenate 'string arcs "died"))
+ (check-topic weimar "http://some.where/city/Weimar")
+ (check-topic city (concatenate 'string types "City"))
+ (check-topic wrote (concatenate 'string arcs "wrote"))
+ (check-topic goethe-literature nil)
+ (check-topic bag (concatenate 'string *rdf-ns* "Bag"))
+ (check-topic _1 (concatenate 'string *rdf-ns* "_1"))
+ (check-topic _2 (concatenate 'string *rdf-ns* "_2"))
+ (check-topic zauberlehrling "http://some.where/poem/Der_Zauberlehrling")
+ (check-topic poem (concatenate 'string types "Poem"))
+ (check-topic dateRange (concatenate 'string arcs "dateRange"))
+ (check-topic start (concatenate 'string arcs "start"))
+ (check-topic end (concatenate 'string arcs "end"))
+ (check-topic title (concatenate 'string arcs "title"))
+ (check-topic content (concatenate 'string arcs "content"))
+ (check-topic erlkoenig "http://some.where/ballad/Der_Erlkoenig")
+ (check-topic ballad (concatenate 'string types "Ballad"))
+ (check-topic de (concatenate 'string constants::*rdf2tm-scope-prefix*
+ "de"))
+ (check-topic prometheus "http://some.where/poem/Prometheus")
+ (check-topic language (concatenate 'string types "Language"))
+ (check-topic full-name (concatenate 'string arcs "fullName"))
+ (is (= (count-if #'(lambda(x)
+ (null (d:psis x)))
+ (elephant:get-instances-by-class 'd:TopicC))
+ 6))))))
(defun run-rdf-importer-tests()
@@ -1840,4 +2721,6 @@
(it.bese.fiveam:run! 'test-import-node-reification)
(it.bese.fiveam:run! 'test-import-dom)
(it.bese.fiveam:run! 'test-poems-rdf-occurrences)
- (it.bese.fiveam:run! 'test-poems-rdf-associations))
\ No newline at end of file
+ (it.bese.fiveam:run! 'test-poems-rdf-associations)
+ (it.bese.fiveam:run! 'test-poems-rdf-typing)
+ (it.bese.fiveam:run! 'test-poems-rdf-topics))
\ 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 Fri Aug 7 11:48:40 2009
@@ -23,8 +23,8 @@
(get-store-spec repository-path)))
(xml-importer:init-isidorus)
(init-rdf-module)
- (rdf-importer rdf-xml-path repository-path :tm-id tm-id)
- :document-id document-id
+ (rdf-importer rdf-xml-path repository-path :tm-id tm-id
+ :document-id document-id)
(when elephant:*store-controller*
(elephant:close-store)))
@@ -409,15 +409,13 @@
topic-id err)))))))))
-(defun make-lang-topic (lang tm-id start-revision tm
+(defun make-lang-topic (lang start-revision tm
&key (document-id *document-id*))
"Returns a topic with the topicid tm-id/lang. If no such topic exist
there will be created one."
- (declare (TopicMapC tm))
- (when (and lang tm-id)
- (tm-id-p tm-id "make-lang-topic")
+ (when lang
(let ((psi-and-topic-id
- (absolutize-value lang nil tm-id)))
+ (concatenate-uri *rdf2tm-scope-prefix* lang)))
(let ((top (get-item-by-id psi-and-topic-id :xtm-id document-id
:revision start-revision)))
(if top
@@ -538,7 +536,7 @@
(let ((type-top (make-topic-stub type nil nil nil start-revision
xml-importer::tm
:document-id document-id))
- (lang-top (make-lang-topic lang tm-id start-revision
+ (lang-top (make-lang-topic lang start-revision
xml-importer::tm
:document-id document-id)))
(let ((occurrence
Modified: trunk/src/xml/rdf/rdf_tools.lisp
==============================================================================
--- trunk/src/xml/rdf/rdf_tools.lisp (original)
+++ trunk/src/xml/rdf/rdf_tools.lisp Fri Aug 7 11:48:40 2009
@@ -31,7 +31,8 @@
*rdf-nil*
*rdf-first*
*rdf-rest*
- *rdf2tm-collection*)
+ *rdf2tm-collection*
+ *rdf2tm-scope-prefix*)
(:import-from :xml-constants
*rdf_core_psis.xtm*)
(:import-from :xml-constants
1
0
Author: lgiessmann
Date: Thu Aug 6 14:05:08 2009
New Revision: 110
Log:
added some unit tests for the rdf-importer
Modified:
trunk/src/unit_tests/fixtures.lisp
trunk/src/unit_tests/rdf_importer_test.lisp
Modified: trunk/src/unit_tests/fixtures.lisp
==============================================================================
--- trunk/src/unit_tests/fixtures.lisp (original)
+++ trunk/src/unit_tests/fixtures.lisp Thu Aug 6 14:05:08 2009
@@ -186,6 +186,7 @@
(tm-id "http://test-tm/")
(document-id "doc-id"))
(clean-out-db db-dir)
+ (setf d:*current-xtm* document-id)
(rdf-importer:setup-rdf-module *poems_light.rdf* db-dir :tm-id tm-id
:document-id document-id)
(elephant:open-store (xml-importer:get-store-spec db-dir))
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 Thu Aug 6 14:05:08 2009
@@ -32,7 +32,8 @@
*rdf-subject*
*rdf-object*
*rdf-predicate*
- *rdf-statement*)
+ *rdf-statement*
+ *xml-string*)
(:import-from :xml-tools
xpath-child-elems-by-qname
xpath-single-child-elem-by-qname
@@ -53,7 +54,8 @@
:test-import-node-1
:test-import-node-reification
:test-import-dom
- :test-poems-rdf-1))
+ :test-poems-rdf-occurrences
+ :test-poems-rdf-associations))
(declaim (optimize (debug 3) (speed 0) (safety 3) (space 0) (compilation-speed 0)))
@@ -1718,26 +1720,113 @@
(elephant:close-store))
-(test test-poems-rdf-1
+(test test-poems-rdf-occurrences
"Tests general functionality of the rdf-importer module with the file
poems_light.rdf."
- (elephant:close-store) ;TODO: remove
(with-fixture rdf-test-db ()
(let ((topics (elephant:get-instances-by-class 'd:TopicC))
(occs (elephant:get-instances-by-class 'd:OccurrenceC))
- (assocs (elephant:get-instances-by-class 'd:AssociationC)))
- (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 65))
- (is (= (length (elephant:get-instances-by-class 'd:OccurrenceC)) 23))
- (is (= (length (elephant:get-instances-by-class 'd:AssociationC)) 30))
-
+ (assocs (elephant:get-instances-by-class 'd:AssociationC))
+ (arcs "http://some.where/relationship/")
+ (date "http://www.w3.org/2001/XMLSchema#date")
+ (long "http://www.w3.org/2001/XMLSchema#unsignedLong"))
+ (is (= (length topics) 65))
+ (is (= (length occs) 23))
+ (is (= (length assocs) 30))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (= (length (d:psis (d:instance-of x))) 1)
+ (string= (d:uri (first (d:psis (d:instance-of x))))
+ (concatenate 'string arcs "firstName"))
+ (string= *xml-string* (d:datatype x))))
+ occs)
+ 1))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (= (length (d:psis (d:instance-of x))) 1)
+ (string= (d:uri (first (d:psis (d:instance-of x))))
+ (concatenate 'string arcs "lastName"))
+ (string= *xml-string* (d:datatype x))))
+ occs)
+ 1))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (= (length (d:psis (d:instance-of x))) 1)
+ (string= (d:uri (first (d:psis (d:instance-of x))))
+ (concatenate 'string arcs "fullName"))
+ (string= *xml-string* (d:datatype x))))
+ occs)
+ 2))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (= (length (d:psis (d:instance-of x))) 1)
+ (string= (d:uri (first (d:psis (d:instance-of x))))
+ (concatenate 'string arcs "nativeName"))
+ (string= *xml-string* (d:datatype x))))
+ occs)
+ 1))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (= (length (d:psis (d:instance-of x))) 1)
+ (string= (d:uri (first (d:psis (d:instance-of x))))
+ (concatenate 'string arcs "title"))
+ (string= *xml-string* (d:datatype x))))
+ occs)
+ 3))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (= (length (d:psis (d:instance-of x))) 1)
+ (string= (d:uri (first (d:psis (d:instance-of x))))
+ (concatenate 'string arcs "content"))
+ (string= *xml-string* (d:datatype x))))
+ occs)
+ 3))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (= (length (d:psis (d:instance-of x))) 1)
+ (string= (d:uri (first (d:psis (d:instance-of x))))
+ (concatenate 'string arcs "population"))
+ (string= long (d:datatype x))))
+ occs)
+ 3))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (= (length (d:psis (d:instance-of x))) 1)
+ (string= (d:uri (first (d:psis (d:instance-of x))))
+ (concatenate 'string arcs "date"))
+ (string= date (d:datatype x))))
+ occs)
+ 2))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (= (length (d:psis (d:instance-of x))) 1)
+ (string= (d:uri (first (d:psis (d:instance-of x))))
+ (concatenate 'string arcs "start"))
+ (string= date (d:datatype x))))
+ occs)
+ 3))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (= (length (d:psis (d:instance-of x))) 1)
+ (string= (d:uri (first (d:psis (d:instance-of x))))
+ (concatenate 'string arcs "end"))
+ (string= date (d:datatype x))))
+ occs)
+ 3)))))
+
- ))
- (elephant:open-store (xml-importer:get-store-spec "data_base"))) ;TODO: remove
+(test test-poems-rdf-associations
+ "Tests general functionality of the rdf-importer module with the file
+ poems_light.rdf."
+ (with-fixture rdf-test-db ()
+ ))
(defun run-rdf-importer-tests()
+ (when elephant:*store-controller*
+ (elephant:close-store))
(it.bese.fiveam:run! 'test-get-literals-of-node)
(it.bese.fiveam:run! 'test-parse-node)
(it.bese.fiveam:run! 'test-get-literals-of-property)
@@ -1750,4 +1839,5 @@
(it.bese.fiveam:run! 'test-import-node-1)
(it.bese.fiveam:run! 'test-import-node-reification)
(it.bese.fiveam:run! 'test-import-dom)
- (it.bese.fiveam:run! 'test-poems-rdf-1))
\ No newline at end of file
+ (it.bese.fiveam:run! 'test-poems-rdf-occurrences)
+ (it.bese.fiveam:run! 'test-poems-rdf-associations))
\ No newline at end of file
1
0
Author: lgiessmann
Date: Thu Aug 6 11:46:11 2009
New Revision: 109
Log:
changed some rdf test files
Added:
trunk/src/unit_tests/poems_light.rdf
Modified:
trunk/src/isidorus.asd
trunk/src/unit_tests/fixtures.lisp
trunk/src/unit_tests/poems.rdf
trunk/src/unit_tests/rdf_importer_test.lisp
trunk/src/unit_tests/unittests-constants.lisp
trunk/src/xml/rdf/rdf_tools.lisp
Modified: trunk/src/isidorus.asd
==============================================================================
--- trunk/src/isidorus.asd (original)
+++ trunk/src/isidorus.asd Thu Aug 6 11:46:11 2009
@@ -106,6 +106,7 @@
(:static-file "atom_test.xtm")
(:static-file "poems.xtm")
(:static-file "poems.rdf")
+ (:static-file "poems_light.rdf")
(:file "atom-conf")
(:file "unittests-constants"
:depends-on ("dangling_topicref.xtm"
Modified: trunk/src/unit_tests/fixtures.lisp
==============================================================================
--- trunk/src/unit_tests/fixtures.lisp (original)
+++ trunk/src/unit_tests/fixtures.lisp Thu Aug 6 11:46:11 2009
@@ -35,7 +35,9 @@
:*NOTIFICATIONBASE-TM*
:*XTM-TM*
:*XTM-MERGE1-TM*
- :*XTM-MERGE2-TM*))
+ :*XTM-MERGE2-TM*
+ :rdf-init-db
+ :rdf-test-db))
(in-package :fixtures)
@@ -166,4 +168,26 @@
(importer *XTM-ATOM-TM* :xtm-id "atom-tm1" :tm-id "http://psi.egovpt.org/tm/egov-ontology"
:revision revision1)
(&body)
+ (tear-down-test-db)))
+
+
+(defun rdf-init-db (&key (db-dir "data_base") (start-revision (get-revision)))
+ "Deletes the data base files and initializes isidorus for rdf."
+ (when elephant:*store-controller*
+ (elephant:close-store))
+ (clean-out-db db-dir)
+ (elephant:open-store (xml-importer:get-store-spec db-dir))
+ (xml-importer:init-isidorus start-revision)
+ (rdf-importer:init-rdf-module start-revision))
+
+
+(def-fixture rdf-test-db ()
+ (let ((db-dir "data_base")
+ (tm-id "http://test-tm/")
+ (document-id "doc-id"))
+ (clean-out-db db-dir)
+ (rdf-importer:setup-rdf-module *poems_light.rdf* db-dir :tm-id tm-id
+ :document-id document-id)
+ (elephant:open-store (xml-importer:get-store-spec db-dir))
+ (&body)
(tear-down-test-db)))
\ No newline at end of file
Modified: trunk/src/unit_tests/poems.rdf
==============================================================================
--- trunk/src/unit_tests/poems.rdf (original)
+++ trunk/src/unit_tests/poems.rdf Thu Aug 6 11:46:11 2009
@@ -55,6 +55,7 @@
<arcs:date rdf:datatype="#date" xml:base="http://www.w3.org/2001/XMLSchema">22.03.1832</arcs:date>
<arcs:place xml:base="">
<types:City rdf:about="Weimar" arcs:fullName="Weimar">
+ <rdfs:subClassOf rdf:resource="http://some.where/types/Region"/>
<arcs:population rdf:datatype="http://www.w3.org/2001/XMLSchema#unsigneLong">64720</arcs:population>
<arcs:locatedIn rdf:resource="http://some.where/country/Germany"/>
</types:City>
@@ -66,7 +67,7 @@
<arcs:wrote>
<rdf:Bag rdf:nodeID="goethe_literature">
<rdf:li>
- <types:Poem>
+ <types:Poem rdf:about="http://some.where/poem/Der_Zauberlehrling">
<arcs:title rdf:parseType="Literal" xml:lang="de">Der Zauberlehrling</arcs:title>
<arcs:dateRange rdf:parseType="Resource" xml:base="http://www.w3.org/2001/XMLSchema"> <!-- rdf:parseType="resource" == bland_node -->
<arcs:start rdf:datatype="#date">01.01.1797</arcs:start>
@@ -194,10 +195,10 @@
<!-- referenced ressources by goethe -->
<rdf:Description rdf:nodeID="goethe_literature">
<rdf:li>
- <types:Ballad arcs:title="Der Erlkönig" xml:lang="de">
+ <types:Ballad rdf:about="http://some.where/ballad/Der_Erlkoenig" arcs:title="Der Erlkönig" xml:lang="de">
<arcs:dateRange rdf:parseType="Resource" xml:base="http://www.w3.org/2001/XMLSchema">
<arcs:start rdf:datatype="#date">01.01.1782</arcs:start>
- <arcs:end rdf:datatype="#date">01.01.1782</arcs:end>
+ <arcs:end rdf:datatype="#date">31.12.1782</arcs:end>
</arcs:dateRange>
<arcs:content rdf:datatype="http://www.w3.org/2001/XMLSchema#string" xml:lang="de">
<![CDATA[Wer reitet so spät durch Nacht und Wind?
@@ -243,7 +244,7 @@
</types:Ballad>
</rdf:li>
<rdf:li>
- <rdf:Description arcs:title="Prometheus">
+ <rdf:Description rdf:about="http://some.where/poem/Prometheus" arcs:title="Prometheus">
<rdf:type rdf:resource="/types/Poem"/>
<arcs:dateRange>
<rdf:Description xml:base="http://does.not.exist">
@@ -354,7 +355,7 @@
<rdf:Description>
<rdf:type rdf:resource="http://www.w3.org/1999/02/22-rdf-syntax-ns#Bag"/>
<rdf:_1>
- <types:Poem arcs:title="Resigantion" xml:lang="de">
+ <types:Poem rdf:about="http://some.where/poem/Resignation" arcs:title="Resigantion" xml:lang="de">
<arcs:dateRange rdf:parseType="Resource">
<arcs:start rdf:datatype="http://www.w3.org/2001/XMLSchema#date">01.01.1786</arcs:start>
<arcs:end rdf:datatype="http://www.w3.org/2001/XMLSchema#date">31.12.1786</arcs:end>
@@ -471,7 +472,7 @@
</types:Poem>
</rdf:_1>
<rdf:_2>
- <types:Drama arcs:title="Die Räuber" xml:lang="de">
+ <types:Drama rdf:about="http://some.where/drama/Die_Raeuber" arcs:title="Die Räuber" xml:lang="de">
<arcs:dateRange>
<rdf:Description>
<arcs:start rdf:datatype="http://www.w3.org/2001/XMLSchema#date">01.01.1781</arcs:start>
@@ -3138,7 +3139,7 @@
<arcs:wrote>
<rdf:Bag>
<rdf:li>
- <types:Poem arcs:title="Mondnacht">
+ <types:Poem rdf:about="http://some.where/poem/Mondnacht" arcs:title="Mondnacht">
<arcs:dateRange rdf:parseType="Resource">
<arcs:start rdf:datatype="http://www.w3.org/2001/XMLSchema#date">01.01.1837</arcs:start>
<arcs:end rdf:datatype="http://www.w3.org/2001/XMLSchema#date">31.12.1837</arcs:end>
@@ -3162,7 +3163,7 @@
</types:Poem>
</rdf:li>
<rdf:li>
- <types:Ballad>
+ <types:Ballad rdf:about="http://some.where/ballad/Die_zwei_Gesellen">
<arcs:title rdf:parseType="Literal">Die zwei Gesellen</arcs:title>
<arcs:title rdf:parseType="Literal">Frühlingsfahrt</arcs:title>
<arcs:dateRange rdf:parseType="Resource">
@@ -3256,7 +3257,7 @@
<arcs:wrote>
<rdf:Bag>
<rdf:_1>
- <types:Poem arcs:title="Venus And Adonis">
+ <types:Poem rdf:about="http://some.where/poem/Venus_And_Adonis" arcs:title="Venus And Adonis">
<arcs:dateRange rdf:parseType="Resource">
<arcs:start rdf:datatype="http://www.w3.org/2001/XMLSchema#date">01.01.1592</arcs:start>
<arcs:end rdf:datatype="http://www.w3.org/2001/XMLSchema#date">31.12.1593</arcs:end>
@@ -4677,7 +4678,7 @@
</types:Poem>
</rdf:_1>
<rdf:_2>
- <types:Drama arcs:title="Venus And Adonis">
+ <types:Drama rdf:about="http://some.where/drama/Romeo_And_Juliet" arcs:title="Romeo and Juliet">
<arcs:dateRange rdf:parseType="Resource">
<arcs:start rdf:datatype="http://www.w3.org/2001/XMLSchema#date">01.01.1597</arcs:start>
<arcs:end rdf:datatype="http://www.w3.org/2001/XMLSchema#date">31.12.1597</arcs:end>
Added: trunk/src/unit_tests/poems_light.rdf
==============================================================================
--- (empty file)
+++ trunk/src/unit_tests/poems_light.rdf Thu Aug 6 11:46:11 2009
@@ -0,0 +1,328 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<rdf:RDF xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
+ xmlns:rdfs="http://www.w3.org/2000/01/rdf-schema#"
+ xmlns:poems="http://some.where/"
+ xmlns:arcs="http://some.where/relationship/"
+ xmlns:types="http://some.where/types/"
+ xml:base="http://some.where/">
+ <!-- === Goethe ========================================================== -->
+ <rdf:Description rdf:about="author/Goethe">
+ <rdf:type rdf:resource="types/Author"/>
+ <arcs:firstName>Johann Wolfgang</arcs:firstName>
+ <arcs:lastName rdf:parseType="Literal">von Goethe</arcs:lastName>
+
+ <!-- === born event ==================================================== -->
+ <arcs:born>
+ <types:Event>
+ <arcs:date rdf:datatype="http://www.w3.org/2001/XMLSchema#date">28.08.1749</arcs:date>
+ <arcs:place>
+ <rdf:Description rdf:about="/region/FrankfurtMain">
+ <rdf:type>
+ <rdf:Description rdf:about="/types/Metropolis">
+ <rdfs:subClassOf rdf:resource="/types/Region"/>
+ </rdf:Description>
+ </rdf:type>
+ <arcs:fullName>Frankfurt am Main</arcs:fullName>
+ <arcs:population rdf:datatype="http://www.w3.org/2001/XMLSchema#unsignedLong">659000</arcs:population>
+ <arcs:locatedIn>
+ <rdf:Description rdf:about="http://some.where/country/Germany">
+ <rdf:type>
+ <rdf:Description rdf:about="http://some.where/types/Country"></rdf:Description>
+ </rdf:type>
+ <arcs:nativeName xml:lang="de">Deutschland</arcs:nativeName>
+ <arcs:population rdf:datatype="http://www.w3.org/2001/XMLSchema#unsignedLong">82099232</arcs:population>
+ <arcs:officialese rdf:resource="language/German"/>
+ <arcs:capital>
+ <rdf:Description rdf:about="http://some.where/region/Berlin">
+ <rdf:type>
+ <rdf:Description rdf:about="http://some.where/types/Metropolis"/>
+ </rdf:type>
+ <arcs:locatedIn rdf:resource="/country/Germany"/>
+ <arcs:population rdf:datatype="http://www.w3.org/2001/XMLSchema#unsignedLong">3431473</arcs:population>
+ </rdf:Description>
+ </arcs:capital>
+ </rdf:Description>
+ </arcs:locatedIn>
+ </rdf:Description>
+ </arcs:place>
+ </types:Event>
+ </arcs:born>
+
+ <!-- === died event ==================================================== -->
+ <arcs:died>
+ <rdf:Description xml:base="http://some.where/types/">
+ <rdf:type rdf:resource="Event"/>
+ <arcs:date rdf:datatype="#date" xml:base="http://www.w3.org/2001/XMLSchema">22.03.1832</arcs:date>
+ <arcs:place xml:base="">
+ <types:City rdf:about="Weimar" arcs:fullName="Weimar">
+ <rdfs:subClassOf rdf:resource="http://some.where/types/Region"/>
+ <arcs:population rdf:datatype="http://www.w3.org/2001/XMLSchema#unsigneLong">64720</arcs:population>
+ <arcs:locatedIn rdf:resource="http://some.where/country/Germany"/>
+ </types:City>
+ </arcs:place>
+ </rdf:Description>
+ </arcs:died>
+
+ <!-- === wrote bag ===================================================== -->
+ <arcs:wrote>
+ <rdf:Bag rdf:nodeID="goethe_literature">
+ <rdf:li>
+ <types:Poem rdf:about="http://some.where/poem/Der_Zauberlehrling">
+ <arcs:title rdf:parseType="Literal" xml:lang="de">Der Zauberlehrling</arcs:title>
+ <arcs:dateRange rdf:parseType="Resource" xml:base="http://www.w3.org/2001/XMLSchema"> <!-- rdf:parseType="resource" == bland_node -->
+ <arcs:start rdf:datatype="#date">01.01.1797</arcs:start>
+ <arcs:end rdf:datatype="#date">31.12.1797</arcs:end>
+ </arcs:dateRange>
+ <arcs:content xml:lang="de">
+ <![CDATA[Hat der alte Hexenmeister
+sich doch einmal wegbegeben!
+Und nun sollen seine Geister
+auch nach meinem Willen leben.
+Seine Wort und Werke
+merkt ich und den Brauch,
+und mit Geistesstärke
+tu ich Wunder auch.
+
+Walle! walle
+Manche Strecke,
+daß, zum Zwecke,
+Wasser fließe
+und mit reichem, vollem Schwalle
+zu dem Bade sich ergieße.
+
+Und nun komm, du alter Besen!
+Nimm die schlechten Lumpenhüllen;
+bist schon lange Knecht gewesen:
+nun erfülle meinen Willen!
+Auf zwei Beinen stehe,
+oben sei ein Kopf,
+eile nun und gehe
+mit dem Wassertopf!
+
+Walle! walle
+manche Strecke,
+daß, zum Zwecke,
+Wasser fließe
+und mit reichem, vollem Schwalle
+zu dem Bade sich ergieße.
+
+Seht, er läuft zum Ufer nieder,
+Wahrlich! ist schon an dem Flusse,
+und mit Blitzesschnelle wieder
+ist er hier mit raschem Gusse.
+Schon zum zweiten Male!
+Wie das Becken schwillt!
+Wie sich jede Schale
+voll mit Wasser füllt!
+
+Stehe! stehe!
+denn wir haben
+deiner Gaben
+vollgemessen! -
+Ach, ich merk es! Wehe! wehe!
+Hab ich doch das Wort vergessen!
+
+Ach, das Wort, worauf am Ende
+er das wird, was er gewesen.
+Ach, er läuft und bringt behende!
+Wärst du doch der alte Besen!
+Immer neue Güsse
+bringt er schnell herein,
+Ach! und hundert Flüsse
+stürzen auf mich ein.
+
+Nein, nicht länger
+kann ichs lassen;
+will ihn fassen.
+Das ist Tücke!
+Ach! nun wird mir immer bänger!
+Welche Mine! welche Blicke!
+
+O du Ausgeburt der Hölle!
+Soll das ganze Haus ersaufen?
+Seh ich über jede Schwelle
+doch schon Wasserströme laufen.
+Ein verruchter Besen,
+der nicht hören will!
+Stock, der du gewesen,
+steh doch wieder still!
+
+Willst am Ende
+gar nicht lassen?
+Will dich fassen,
+will dich halten
+und das alte Holz behende
+mit dem scharfen Beile spalten.
+
+Seht da kommt er schleppend wieder!
+Wie ich mich nur auf dich werfe,
+gleich, o Kobold, liegst du nieder;
+krachend trifft die glatte Schärfe.
+Wahrlich, brav getroffen!
+Seht, er ist entzwei!
+Und nun kann ich hoffen,
+und ich atme frei!
+
+Wehe! wehe!
+Beide Teile
+stehn in Eile
+schon als Knechte
+völlig fertig in die Höhe!
+Helft mir, ach! ihr hohen Mächte!
+
+Und sie laufen! Naß und nässer
+wirds im Saal und auf den Stufen.
+Welch entsetzliches Gewässer!
+Herr und Meister! hör mich rufen! -
+Ach, da kommt der Meister!
+Herr, die Not ist groß!
+Die ich rief, die Geister
+werd ich nun nicht los.
+
+"In die Ecke,
+Besen, Besen!
+Seids gewesen.
+Denn als Geister
+ruft euch nur zu diesem Zwecke,
+erst hervor der alte Meister."]]>
+ </arcs:content>
+ </types:Poem>
+ </rdf:li>
+ </rdf:Bag>
+ </arcs:wrote>
+ </rdf:Description>
+
+ <!-- referenced ressources by goethe -->
+ <rdf:Description rdf:nodeID="goethe_literature">
+ <rdf:li>
+ <types:Ballad rdf:about="http://some.where/ballad/Der_Erlkoenig" arcs:title="Der Erlkönig" xml:lang="de">
+ <arcs:dateRange rdf:parseType="Resource" xml:base="http://www.w3.org/2001/XMLSchema">
+ <arcs:start rdf:datatype="#date">01.01.1782</arcs:start>
+ <arcs:end rdf:datatype="#date">31.12.1782</arcs:end>
+ </arcs:dateRange>
+ <arcs:content rdf:datatype="http://www.w3.org/2001/XMLSchema#string" xml:lang="de">
+ <![CDATA[Wer reitet so spät durch Nacht und Wind?
+Es ist der Vater mit seinem Kind;
+Er hat den Knaben wohl in dem Arm,
+Er faßt ihn sicher, er hält ihn warm.
+
+Mein Sohn, was birgst du so bang dein Gesicht? -
+Siehst Vater, du den Erlkönig nicht?
+Den Erlenkönig mit Kron und Schweif? -
+Mein Sohn, es ist ein Nebelstreif. -
+
+"Du liebes Kind, komm, geh mit mir!
+Gar schöne Spiele spiel ich mit dir;
+Manch bunte Blumen sind an dem Strand,
+Meine Mutter hat manch gülden Gewand."
+
+Mein Vater, mein Vater, und hörest du nicht,
+Was Erlenkönig mir leise verspricht? -
+Sei ruhig, bleibe ruhig, mein Kind;
+In dürren Blättern säuselt der Wind. -
+
+"Willst, feiner Knabe, du mit mir gehn?
+Meine Töchter sollen dich warten schön;
+Meine Töchter führen den nächtlichen Reihn
+Und wiegen und tanzen und singen dich ein."
+
+Mein Vater, mein Vater, und siehst du nicht dort
+Erlkönigs Töchter am düstern Ort? -
+Mein Sohn, mein Sohn, ich seh es genau:
+Es scheinen die alten Weiden so grau. -
+
+"Ich liebe dich, mich reizt deine schöne Gestalt;
+Und bist du nicht willig, so brauch ich Gewalt."
+Mein Vater, mein Vater, jetzt faßt er mich an!
+Erlkönig hat mir ein Leids getan! -
+
+Dem Vater grauset's, er reitet geschwind,
+Er hält in den Armen das ächzende Kind,
+Erreicht den Hof mit Mühe und Not;
+In seinen Armen das Kind war tot.]]>
+ </arcs:content>
+ </types:Ballad>
+ </rdf:li>
+ <rdf:li>
+ <rdf:Description rdf:about="http://some.where/poem/Prometheus" arcs:title="Prometheus">
+ <rdf:type rdf:resource="/types/Poem"/>
+ <arcs:dateRange>
+ <rdf:Description xml:base="http://does.not.exist">
+ <arcs:start rdf:datatype="http://www.w3.org/2001/XMLSchema#date">1772</arcs:start>
+ <arcs:end rdf:datatype="http://www.w3.org/2001/XMLSchema#date">1774</arcs:end>
+ </rdf:Description>
+ </arcs:dateRange>
+ <arcs:content rdf:parseType="Literal" xml:lang="de">
+ <![CDATA[Bedecke deinen Himmel, Zeus,
+Mit Wolkendunst!
+Und übe, Knaben gleich,
+Der Disteln köpft,
+An Eichen dich und Bergeshöh'n!
+Mußt mir meine Erde
+Doch lassen steh'n,
+Und meine Hütte,
+Die du nicht gebaut,
+Und meinen Herd,
+Um dessen Glut
+Du mich beneidest.
+
+Ich kenne nichts Ärmeres
+Unter der Sonn' als euch Götter!
+Ihr nähret kümmerlich
+Von Opfersteuern
+Und Gebetshauch
+Eure Majestät
+Und darbtet, wären
+Nicht Kinder und Bettler
+Hoffnungsvolle Toren.
+
+Da ich ein Kind war,
+Nicht wußte, wo aus, wo ein,
+Kehrt' ich mein verirrtes Auge
+Zur Sonne, als wenn drüber wär
+Ein Ohr zu hören meine Klage,
+Ein Herz wie meins,
+Sich des Bedrängten zu erbarmen.
+
+Wer half mir
+Wider der Titanen Übermut?
+Wer rettete vom Tode mich,
+Von Sklaverei?
+Hast du's nicht alles selbst vollendet,
+Heilig glühend Herz?
+Und glühtest, jung und gut,
+Betrogen, Rettungsdank
+Dem Schlafenden dadroben?
+
+Ich dich ehren? Wofür?
+Hast du die Schmerzen gelindert
+Je des Beladenen?
+Hast du die Tränen gestillet
+Je des Geängsteten?
+Hat nicht mich zum Manne geschmiedet
+Die allmächtige Zeit
+Und das ewige Schicksal,
+Meine Herren und deine?
+
+Wähntest du etwa,
+Ich sollte das Leben hassen,
+In Wüsten fliehn,
+Weil nicht alle Knabenmorgen-
+Blütenträume reiften?
+
+Hier sitz' ich, forme Menschen
+Nach meinem Bilde,
+Ein Geschlecht, das mir gleich sei,
+Zu leiden, weinen,
+Genießen und zu freuen sich,
+Und dein nicht zu achten,
+Wie ich!]]>
+ </arcs:content>
+ </rdf:Description>
+ </rdf:li>
+ </rdf:Description>
+
+ <rdf:Description rdf:about="http://some.where/language/German">
+ <rdf:type rdf:resource="types/Language"/>
+ </rdf:Description>
+</rdf:RDF>
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 Thu Aug 6 11:46:11 2009
@@ -52,7 +52,8 @@
:test-parse-properties-of-node
:test-import-node-1
:test-import-node-reification
- :test-import-dom))
+ :test-import-dom
+ :test-poems-rdf-1))
(declaim (optimize (debug 3) (speed 0) (safety 3) (space 0) (compilation-speed 0)))
@@ -65,16 +66,6 @@
(in-suite rdf-importer-test)
-(defun rdf-init-db (&key (db-dir "data_base") (start-revision (get-revision)))
- "Empties the data base files and initializes isidorus for rdf."
- (when elephant:*store-controller*
- (elephant:close-store))
- (clean-out-db db-dir)
- (elephant:open-store (xml-importer:get-store-spec db-dir))
- (xml-importer:init-isidorus start-revision)
- (rdf-importer:init-rdf-module start-revision))
-
-
(test test-get-literals-of-node
"Tests the helper function get-literals-of-node."
(let ((doc-1
@@ -1727,6 +1718,24 @@
(elephant:close-store))
+(test test-poems-rdf-1
+ "Tests general functionality of the rdf-importer module with the file
+ poems_light.rdf."
+ (elephant:close-store) ;TODO: remove
+ (with-fixture rdf-test-db ()
+ (let ((topics (elephant:get-instances-by-class 'd:TopicC))
+ (occs (elephant:get-instances-by-class 'd:OccurrenceC))
+ (assocs (elephant:get-instances-by-class 'd:AssociationC)))
+ (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 65))
+ (is (= (length (elephant:get-instances-by-class 'd:OccurrenceC)) 23))
+ (is (= (length (elephant:get-instances-by-class 'd:AssociationC)) 30))
+
+
+ ))
+ (elephant:open-store (xml-importer:get-store-spec "data_base"))) ;TODO: remove
+
+
+
(defun run-rdf-importer-tests()
(it.bese.fiveam:run! 'test-get-literals-of-node)
@@ -1740,4 +1749,5 @@
(it.bese.fiveam:run! 'test-parse-properties-of-node)
(it.bese.fiveam:run! 'test-import-node-1)
(it.bese.fiveam:run! 'test-import-node-reification)
- (it.bese.fiveam:run! 'test-import-dom))
\ No newline at end of file
+ (it.bese.fiveam:run! 'test-import-dom)
+ (it.bese.fiveam:run! 'test-poems-rdf-1))
\ No newline at end of file
Modified: trunk/src/unit_tests/unittests-constants.lisp
==============================================================================
--- trunk/src/unit_tests/unittests-constants.lisp (original)
+++ trunk/src/unit_tests/unittests-constants.lisp Thu Aug 6 11:46:11 2009
@@ -28,7 +28,8 @@
:*sample_objects.xtm*
:*t100.xtm*
:*atom_test.xtm*
- :*atom-conf.lisp*))
+ :*atom-conf.lisp*
+ :*poems_light.rdf*))
(in-package :unittests-constants)
@@ -89,3 +90,7 @@
(defparameter *atom-conf.lisp*
(asdf:component-pathname
(asdf:find-component *unit-tests-component* "atom-conf")))
+
+(defparameter *poems_light.rdf*
+ (asdf:component-pathname
+ (asdf:find-component *unit-tests-component* "poems_light.rdf")))
\ No newline at end of file
Modified: trunk/src/xml/rdf/rdf_tools.lisp
==============================================================================
--- trunk/src/xml/rdf/rdf_tools.lisp (original)
+++ trunk/src/xml/rdf/rdf_tools.lisp Thu Aug 6 11:46:11 2009
@@ -75,10 +75,10 @@
(in-package :rdf-importer)
(defvar *rdf-types* (list "Description" "List" "Alt" "Bag" "Seq"
- "Statement" "Property" "XMLLiteral"))
+ "Statement" "Property" "XMLLiteral" "nil"))
(defvar *rdf-properties* (list "type" "first" "rest" "subject" "predicate"
- "object" "li"))
+ "object" "li" "first" "rest"))
(defvar *rdfs-types* (list "Resource" "Literal" "Class" "Datatype"
"Container" "ContainerMembershipProperty"))
1
0
Author: lgiessmann
Date: Wed Aug 5 11:45:12 2009
New Revision: 108
Log:
rdf-importer: added some unit tests
Modified:
trunk/src/unit_tests/rdf_importer_test.lisp
trunk/src/xml/rdf/importer.lisp
Modified: trunk/src/unit_tests/rdf_importer_test.lisp
==============================================================================
--- trunk/src/unit_tests/rdf_importer_test.lisp (original)
+++ trunk/src/unit_tests/rdf_importer_test.lisp Wed Aug 5 11:45:12 2009
@@ -1443,37 +1443,288 @@
(doc-1
(concatenate 'string "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" "
"xmlns:arcs=\"http://test/arcs/\">"
- "<rdf:Description rdf:about=\"first-node\">"
- "<rdf:type rdf:nodeID=\"second-node\"/>"
- "<arcs:arc1 rdf:resource=\"third-node\"/>"
- "<arcs:arc2 rdf:datatype=\"long\">123</arcs:arc2>"
- "<arcs:arc3>"
- "<rdf:Description>"
- "<arcs:arc4 rdf:parseType=\"Collection\">"
- "<rdf:Description rdf:about=\"item-1\"/>"
- "<rdf:Description rdf:about=\"item-2\">"
- "<arcs:arc5 rdf:parseType=\"Resource\">"
- "<arcs:arc6 rdf:resource=\"fourth-node\"/>"
- "<arcs:arc7>"
- "<rdf:Description rdf:about=\"fifth-node\"/>"
- "</arcs:arc7>"
- "<arcs:arc8 rdf:parseType=\"Collection\" />"
- "</arcs:arc5>"
- "</rdf:Description>"
- "</arcs:arc4>"
- "</rdf:Description>"
- "</arcs:arc3>"
- "</rdf:Description>"
- "<rdf:Description rdf:nodeID=\"second-node\" />"
+ " <rdf:Description rdf:about=\"first-node\">"
+ " <rdf:type rdf:nodeID=\"second-node\"/>"
+ " <arcs:arc1 rdf:resource=\"third-node\"/>"
+ " <arcs:arc2 rdf:datatype=\"long\">123</arcs:arc2>"
+ " <arcs:arc3>"
+ " <rdf:Description>"
+ " <arcs:arc4 rdf:parseType=\"Collection\">"
+ " <rdf:Description rdf:about=\"item-1\"/>"
+ " <rdf:Description rdf:about=\"item-2\">"
+ " <arcs:arc5 rdf:parseType=\"Resource\">"
+ " <arcs:arc6 rdf:resource=\"fourth-node\"/>"
+ " <arcs:arc7>"
+ " <rdf:Description rdf:about=\"fifth-node\"/>"
+ " </arcs:arc7>"
+ " <arcs:arc8 rdf:parseType=\"Collection\" />"
+ " </arcs:arc5>"
+ " </rdf:Description>"
+ " </arcs:arc4>"
+ " </rdf:Description>"
+ " </arcs:arc3>"
+ " </rdf:Description>"
+ " <rdf:Description rdf:nodeID=\"second-node\" />"
"</rdf:RDF>")))
(let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder))))
(is-true dom-1)
(is (= (length (dom:child-nodes dom-1)) 1))
(rdf-init-db :db-dir db-dir :start-revision revision-1)
(let ((rdf-node (elt (dom:child-nodes dom-1) 0)))
- (is (= (length (dom:child-nodes rdf-node)) 2))
+ (is (= (length (rdf-importer::child-nodes-or-text rdf-node
+ :trim t))
+ 2))
(rdf-importer::import-dom rdf-node revision-1 :tm-id tm-id
- :document-id document-id)))))
+ :document-id document-id)
+ (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 38))
+ (is (= (length (elephant:get-instances-by-class 'd:AssociationC)) 10))
+ (setf rdf-importer::*current-xtm* document-id)
+ (is (= (length
+ (intersection
+ (map 'list #'d:instance-of
+ (elephant:get-instances-by-class 'd:AssociationC))
+ (list
+ (d:get-item-by-id (concatenate
+ 'string
+ constants::*rdf2tm-collection*)
+ :xtm-id rdf-importer::*rdf-core-xtm*)
+ (d:get-item-by-psi constants::*type-instance-psi*)
+ (dotimes (iter 9)
+ (let ((pos (+ iter 1))
+ (topics nil))
+ (when (/= pos 2)
+ (push (get-item-by-id
+ (concatenate
+ 'string "http://test/arcs/arc"
+ (write-to-string pos))) topics))
+ topics)))))))
+ (let ((first-node (get-item-by-id "http://test-tm/first-node"))
+ (second-node (get-item-by-id "second-node"))
+ (third-node (get-item-by-id "http://test-tm/third-node"))
+ (fourth-node (get-item-by-id "http://test-tm/fourth-node"))
+ (fifth-node (get-item-by-id "http://test-tm/fifth-node"))
+ (item-1 (get-item-by-id "http://test-tm/item-1"))
+ (item-2 (get-item-by-id "http://test-tm/item-2"))
+ (arc1 (get-item-by-id "http://test/arcs/arc1"))
+ (arc2 (get-item-by-id "http://test/arcs/arc2"))
+ (arc3 (get-item-by-id "http://test/arcs/arc3"))
+ (arc4 (get-item-by-id "http://test/arcs/arc4"))
+ (arc5 (get-item-by-id "http://test/arcs/arc5"))
+ (arc6 (get-item-by-id "http://test/arcs/arc6"))
+ (arc7 (get-item-by-id "http://test/arcs/arc7"))
+ (arc8 (get-item-by-id "http://test/arcs/arc8"))
+ (instance (d:get-item-by-psi constants::*instance-psi*))
+ (type (d:get-item-by-psi constants::*type-psi*))
+ (type-instance (d:get-item-by-psi
+ constants:*type-instance-psi*))
+ (subject (d:get-item-by-psi constants::*rdf2tm-subject*))
+ (object (d:get-item-by-psi constants::*rdf2tm-object*))
+ (collection (d:get-item-by-id
+ constants::*rdf2tm-collection*)))
+ (is (= (length (d:psis first-node)) 1))
+ (is (string= (d:uri (first (d:psis first-node)))
+ "http://test-tm/first-node"))
+ (is (= (length (d:psis second-node)) 0))
+ (is (= (length (d:psis third-node)) 1))
+ (is (string= (d:uri (first (d:psis third-node)))
+ "http://test-tm/third-node"))
+ (is (= (length (d:psis fourth-node)) 1))
+ (is (string= (d:uri (first (d:psis fourth-node)))
+ "http://test-tm/fourth-node"))
+ (is (= (length (d:psis fifth-node)) 1))
+ (is (string= (d:uri (first (d:psis fifth-node)))
+ "http://test-tm/fifth-node"))
+ (is (= (length (d:psis item-1)) 1))
+ (is (string= (d:uri (first (d:psis item-1)))
+ "http://test-tm/item-1"))
+ (is (= (length (d:psis item-2)) 1))
+ (is (string= (d:uri (first (d:psis item-2)))
+ "http://test-tm/item-2"))
+ (is (= (length (d:psis arc1)) 1))
+ (is (string= (d:uri (first (d:psis arc1)))
+ "http://test/arcs/arc1"))
+ (is (= (length (d:psis arc2)) 1))
+ (is (string= (d:uri (first (d:psis arc2)))
+ "http://test/arcs/arc2"))
+ (is (= (length (d:psis arc3)) 1))
+ (is (string= (d:uri (first (d:psis arc3)))
+ "http://test/arcs/arc3"))
+ (is (= (length (d:psis arc4)) 1))
+ (is (string= (d:uri (first (d:psis arc4)))
+ "http://test/arcs/arc4"))
+ (is (= (length (d:psis arc5)) 1))
+ (is (string= (d:uri (first (d:psis arc5)))
+ "http://test/arcs/arc5"))
+ (is (= (length (d:psis arc6)) 1))
+ (is (string= (d:uri (first (d:psis arc6)))
+ "http://test/arcs/arc6"))
+ (is (= (length (d:psis arc7)) 1))
+ (is (string= (d:uri (first (d:psis arc7)))
+ "http://test/arcs/arc7"))
+ (is (= (length (d:psis arc8)) 1))
+ (is (string= (d:uri (first (d:psis arc8)))
+ "http://test/arcs/arc8"))
+ (is (= (length (elephant:get-instances-by-class 'd:OccurrenceC))
+ 1))
+ (is (string= (d:charvalue (first (elephant:get-instances-by-class
+ 'd:OccurrenceC)))
+ "123"))
+ (is (string= (d:datatype (first (elephant:get-instances-by-class
+ 'd:OccurrenceC)))
+ "http://test-tm/long"))
+ (is (= (length (d:occurrences first-node)) 1))
+ (is (= (length (d:player-in-roles first-node)) 3))
+ (is (= (count-if
+ #'(lambda(x)
+ (or (and (eql (d:instance-of x) instance)
+ (eql (d:instance-of (d:parent x))
+ type-instance))
+ (and (eql (d:instance-of x) subject)
+ (eql (d:instance-of (d:parent x)) arc1))
+ (and (eql (d:instance-of x) subject)
+ (eql (d:instance-of (d:parent x)) arc3))))
+ (d:player-in-roles first-node))
+ 3))
+ (is (= (length (d:player-in-roles second-node)) 1))
+ (is-true (find-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) type)
+ (eql (d:instance-of (d:parent x))
+ type-instance)))
+ (d:player-in-roles second-node)))
+ (is (= (length (d:player-in-roles third-node)) 1))
+ (is-true (find-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) object)
+ (eql (d:instance-of (d:parent x))
+ arc1)))
+ (d:player-in-roles third-node)))
+ (let ((uuid-1
+ (d:player
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) object)
+ (= 0 (length (d:psis (d:player y))))))
+ (d:roles
+ (d:parent
+ (find-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) subject)
+ (eql (d:instance-of (d:parent x)) arc3)))
+ (d:player-in-roles first-node))))))))
+ (is-true uuid-1)
+ (is (= (length (d:player-in-roles uuid-1)) 2))
+ (is-true (find-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) subject)
+ (eql (d:instance-of (d:parent x)) arc4)))
+ (d:player-in-roles uuid-1)))
+ (let ((col-1
+ (d:player
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) object)
+ (= 0 (length (d:psis (d:player y))))))
+ (d:roles
+ (d:parent
+ (find-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) subject)
+ (eql (d:instance-of (d:parent x)) arc4)))
+ (d:player-in-roles uuid-1))))))))
+ (is-true col-1)
+ (is (= (length (d:player-in-roles col-1)) 2))
+ (is-true (find-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) subject)
+ (eql (d:instance-of (d:parent x))
+ collection)))
+ (d:player-in-roles col-1)))
+ (let ((col-assoc
+ (d:parent
+ (find-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) subject)
+ (eql (d:instance-of (d:parent x))
+ collection)))
+ (d:player-in-roles col-1)))))
+ (is-true col-assoc)
+ (is (= (length (d:roles col-assoc)) 3))
+ (is (= (count-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) object)
+ (or (eql (d:player x) item-1)
+ (eql (d:player x) item-2))))
+ (d:roles col-assoc))
+ 2))))
+ (is (= (length (d:player-in-roles item-1)) 1))
+ (is (= (length (d:player-in-roles item-2)) 2))
+ (is-true (find-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) subject)
+ (eql (d:instance-of (d:parent x)) arc5)))
+ (d:player-in-roles item-2)))
+ (let ((uuid-2
+ (d:player
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) object)
+ (= 0 (length (d:psis (d:player y))))))
+ (d:roles
+ (d:parent
+ (find-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) subject)
+ (eql (d:instance-of (d:parent x)) arc5)))
+ (d:player-in-roles item-2))))))))
+ (is-true uuid-2)
+ (is (= (length (d:player-in-roles uuid-2)) 4))
+ (is (= (count-if
+ #'(lambda(x)
+ (or (and (eql (d:instance-of x) object)
+ (eql (d:instance-of (d:parent x)) arc5))
+ (and (eql (d:instance-of x) subject)
+ (or
+ (eql (d:instance-of (d:parent x)) arc6)
+ (eql (d:instance-of (d:parent x)) arc7)
+ (eql (d:instance-of
+ (d:parent x)) arc8)))))
+ (d:player-in-roles uuid-2))
+ 4))
+ (is (= (length (d:player-in-roles fourth-node)) 1))
+ (is (= (length (d:player-in-roles fifth-node)) 1))
+ (let ((col-2
+ (d:player
+ (find-if
+ #'(lambda(y)
+ (and (eql (d:instance-of y) object)
+ (= 0 (length (d:psis (d:player y))))))
+ (d:roles
+ (d:parent
+ (find-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) subject)
+ (eql (d:instance-of (d:parent x)) arc8)))
+ (d:player-in-roles uuid-2))))))))
+ (is-true col-2)
+ (is (= (length (d:player-in-roles col-2)) 2))
+ (is-true (find-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) subject)
+ (eql (d:instance-of (d:parent x))
+ collection)))
+ (d:player-in-roles col-2)))
+ (let ((col-assoc
+ (d:parent
+ (find-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) subject)
+ (eql (d:instance-of (d:parent x))
+ collection)))
+ (d:player-in-roles col-2)))))
+ (is-true col-assoc)
+ (is (= (length (d:roles col-assoc)) 1))))))))))
+ (elephant:close-store))
Modified: trunk/src/xml/rdf/importer.lisp
==============================================================================
--- trunk/src/xml/rdf/importer.lisp (original)
+++ trunk/src/xml/rdf/importer.lisp Wed Aug 5 11:45:12 2009
@@ -167,12 +167,19 @@
(with-tm (start-revision document-id tm-id)
(let ((this (get-item-by-id UUID :xtm-id document-id
:revision start-revision)))
- (let ((literals (append (get-literals-of-node elem fn-xml-lang)
+ (let ((literals (append (get-literals-of-property elem fn-xml-lang)
(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 (get-types-of-node-content elem tm-id fn-xml-base))
+ (types (remove-if
+ #'null
+ (append
+ (get-types-of-node-content elem tm-id fn-xml-base)
+ (when (get-ns-attribute elem "type")
+ (list :ID nil
+ :topicid (get-ns-attribute elem "type")
+ :psi (get-ns-attribute elem "type"))))))
(super-classes
(get-super-classes-of-node-content elem tm-id xml-base)))
(make-literals this literals tm-id start-revision
@@ -286,8 +293,6 @@
super-classes))
-
-
(defun make-supertype-subtype-association (sub-top super-top reifier-id
start-revision tm
&key (document-id *document-id*))
1
0
Author: lgiessmann
Date: Wed Aug 5 07:58:19 2009
New Revision: 107
Log:
fixed a bug in the rdf-importer which occurs when the rdf-file contains a collection
Modified:
trunk/src/unit_tests/rdf_importer_test.lisp
trunk/src/xml/rdf/importer.lisp
trunk/src/xml/rdf/rdf_core_psis.xtm
trunk/src/xml/rdf/rdf_tools.lisp
Modified: trunk/src/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 5 07:58:19 2009
@@ -1038,7 +1038,7 @@
(rdf-init-db :db-dir db-dir :start-revision revision-1)
(rdf-importer::import-node node tm-id revision-2
:document-id document-id)
- (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 20))
+ (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 21))
(let ((first-node (get-item-by-id "http://test-tm/first-node"
:xtm-id document-id))
(first-type (get-item-by-id "http://test-tm/first-type"
@@ -1442,27 +1442,29 @@
(document-id "doc-id")
(doc-1
(concatenate 'string "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" "
- "xmlns:arcs=\"http://test/arcs/\" "
- "xmlns:rdfs=\"" *rdfs-ns* "\">"
- "<rdf:Description1 rdf:about=\"first-node\">"
+ "xmlns:arcs=\"http://test/arcs/\">"
+ "<rdf:Description rdf:about=\"first-node\">"
"<rdf:type rdf:nodeID=\"second-node\"/>"
"<arcs:arc1 rdf:resource=\"third-node\"/>"
"<arcs:arc2 rdf:datatype=\"long\">123</arcs:arc2>"
"<arcs:arc3>"
- "<rdf:Description3>"
+ "<rdf:Description>"
"<arcs:arc4 rdf:parseType=\"Collection\">"
- "<rdf:Description4 rdf:about=\"item-1\"/>"
- "<rdf:Description5 rdf:about=\"item-2\">"
+ "<rdf:Description rdf:about=\"item-1\"/>"
+ "<rdf:Description rdf:about=\"item-2\">"
"<arcs:arc5 rdf:parseType=\"Resource\">"
- "<arcs:arc7 rdf:resource=\"fourth-node\"/>"
+ "<arcs:arc6 rdf:resource=\"fourth-node\"/>"
+ "<arcs:arc7>"
+ "<rdf:Description rdf:about=\"fifth-node\"/>"
+ "</arcs:arc7>"
"<arcs:arc8 rdf:parseType=\"Collection\" />"
"</arcs:arc5>"
- "</rdf:Description5>"
+ "</rdf:Description>"
"</arcs:arc4>"
- "</rdf:Description3>"
+ "</rdf:Description>"
"</arcs:arc3>"
- "</rdf:Description1>"
- "<rdf:Description2 rdf:nodeID=\"second-node\" />"
+ "</rdf:Description>"
+ "<rdf:Description rdf:nodeID=\"second-node\" />"
"</rdf:RDF>")))
(let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder))))
(is-true dom-1)
Modified: trunk/src/xml/rdf/importer.lisp
==============================================================================
--- trunk/src/xml/rdf/importer.lisp (original)
+++ trunk/src/xml/rdf/importer.lisp Wed Aug 5 07:58:19 2009
@@ -98,7 +98,7 @@
(defun import-node (elem tm-id start-revision &key (document-id *document-id*)
(xml-base nil) (xml-lang nil))
- (format t ">> import-node: ~a <<~%" (dom:node-name elem))
+ (format t ">> import-node: ~a <<~%" (dom:node-name elem)) ;TODO: remove
(tm-id-p tm-id "import-node")
(parse-node elem)
;TODO: handle Collections that are made manually without
@@ -154,7 +154,7 @@
"Imports a property that is an blank_node and continues the recursion
on this element."
(declare (dom:element elem))
- (format t ">> import-arc: ~a <<~%" (dom:node-name elem))
+ (format t ">> import-arc: ~a <<~%" (dom:node-name elem)) ;TODO: remove
(let ((fn-xml-lang (get-xml-lang elem :old-lang xml-lang))
(fn-xml-base (get-xml-base elem :old-base xml-base))
(UUID (get-ns-attribute elem "UUID" :ns-uri *rdf2tm-ns*))
@@ -848,7 +848,8 @@
(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))
- (parseType (get-ns-attribute arc "parseType")))
+ (parseType (get-ns-attribute arc "parseType"))
+ (UUID (get-ns-attribute arc "UUID" :ns-uri *rdf2tm-ns*)))
(let ((datatype (get-absolute-attribute arc tm-id xml-base "datatype"))
(type (get-absolute-attribute arc tm-id xml-base "type"))
(resource (get-absolute-attribute arc tm-id xml-base "resource"))
@@ -856,9 +857,15 @@
(literals (get-literals-of-property arc xml-lang)))
(if (and parseType
(string= parseType "Collection"))
- (loop for item across content
- do (import-node item tm-id start-revision :document-id document-id
- :xml-base fn-xml-base :xml-lang fn-xml-lang))
+ (let ((this
+ (with-tm (start-revision document-id tm-id)
+ (make-topic-stub nil nil nil UUID start-revision
+ xml-importer::tm
+ :document-id document-id))))
+ (make-collection arc this tm-id start-revision
+ :document-id document-id
+ :xml-base xml-base
+ :xml-lang xml-lang))
(if (or datatype resource nodeID
(and parseType
(string= parseType "Literal"))
Modified: trunk/src/xml/rdf/rdf_core_psis.xtm
==============================================================================
--- trunk/src/xml/rdf/rdf_core_psis.xtm (original)
+++ trunk/src/xml/rdf/rdf_core_psis.xtm Wed Aug 5 07:58:19 2009
@@ -23,6 +23,13 @@
<value>object</value>
</name>
</topic>
+
+ <topic id="collection">
+ <subjectIdentifier href="http://isidorus/rdf2tm_mapping#collection"/>
+ <name>
+ <value>object</value>
+ </name>
+ </topic>
<topic id="supertype-subtype">
<subjectIdentifier href="http://psi.topicmaps.org/iso13250/model/supertype-subtype"/>
Modified: trunk/src/xml/rdf/rdf_tools.lisp
==============================================================================
--- trunk/src/xml/rdf/rdf_tools.lisp (original)
+++ trunk/src/xml/rdf/rdf_tools.lisp Wed Aug 5 07:58:19 2009
@@ -214,7 +214,7 @@
(error "text-content not allowed here!")))
(condition (err) (error "~a~a" err-pref err)))
(when (or resource datatype parseType class subClassOf)
- (error "~a~a is not allowed here!"
+ (error "~a~a is not allowed here (~a)!"
err-pref (cond
(resource (concatenate 'string "resource("
resource ")"))
@@ -224,7 +224,8 @@
parseType ")"))
(class (concatenate 'string "Class(" class ")"))
(subClassOf (concatenate 'string "subClassOf("
- subClassOf ")")))))
+ subClassOf ")")))
+ (dom:node-name node)))
(dolist (item *rdf-types*)
(when (get-ns-attribute node item)
(error "~ardf:~a is a type and not allowed here!"
1
0
Author: lgiessmann
Date: Wed Aug 5 06:53:45 2009
New Revision: 106
Log:
added a function that from import-node furhter function to import the entire dom recursively
Modified:
trunk/src/constants.lisp
trunk/src/unit_tests/poems.rdf
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 Wed Aug 5 06:53:45 2009
@@ -32,8 +32,12 @@
:*rdf-object*
:*rdf-subject*
:*rdf-predicate*
+ :*rdf-nil*
+ :*rdf-first*
+ :*rdf-rest*
:*rdf2tm-object*
- :*rdf2tm-subject*))
+ :*rdf2tm-subject*
+ :*rdf2tm-collection*))
(in-package :constants)
(defparameter *xtm2.0-ns* "http://www.topicmaps.org/xtm/")
@@ -80,6 +84,14 @@
(defparameter *rdf-predicate* "http://www.w3.org/1999/02/22-rdf-syntax-ns#predicate")
+(defparameter *rdf-nil* "http://www.w3.org/1999/02/22-rdf-syntax-ns#nil")
+
+(defparameter *rdf-first* "http://www.w3.org/1999/02/22-rdf-syntax-ns#first")
+
+(defparameter *rdf-rest* "http://www.w3.org/1999/02/22-rdf-syntax-ns#rest")
+
(defparameter *rdf2tm-object* "http://isidorus/rdf2tm_mapping#object")
-(defparameter *rdf2tm-subject* "http://isidorus/rdf2tm_mapping#subject")
\ No newline at end of file
+(defparameter *rdf2tm-subject* "http://isidorus/rdf2tm_mapping#subject")
+
+(defparameter *rdf2tm-collection* "http://isidorus/rdf2tm_mapping#collection")
\ No newline at end of file
Modified: trunk/src/unit_tests/poems.rdf
==============================================================================
--- trunk/src/unit_tests/poems.rdf (original)
+++ trunk/src/unit_tests/poems.rdf Wed Aug 5 06:53:45 2009
@@ -3165,10 +3165,10 @@
<types:Ballad>
<arcs:title rdf:parseType="Literal">Die zwei Gesellen</arcs:title>
<arcs:title rdf:parseType="Literal">Frühlingsfahrt</arcs:title>
- <arcs:daterange rdf:parseType="Resource">
+ <arcs:dateRange rdf:parseType="Resource">
<arcs:start rdf:datatype="http://www.w3.org/2001/XMLSchema#date">01.01.1818</arcs:start>
<arcs:end rdf:datatype="http://www.w3.org/2001/XMLSchema#date">31.12.1818</arcs:end>
- </arcs:daterange>
+ </arcs:dateRange>
<arcs:content rdf:parseType="Literal" xml:lang="de">
<![CDATA[Es zogen zwei rüst’ge Gesellen
Zum erstenmal von Haus,
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 5 06:53:45 2009
@@ -51,7 +51,8 @@
:test-get-associations-of-node-content
:test-parse-properties-of-node
:test-import-node-1
- :test-import-node-reification))
+ :test-import-node-reification
+ :test-import-dom))
(declaim (optimize (debug 3) (speed 0) (safety 3) (space 0) (compilation-speed 0)))
@@ -1433,6 +1434,46 @@
(elephant:close-store))))))
+(test test-import-dom
+ "Tests the function import-node when used recursively."
+ (let ((db-dir "data_base")
+ (tm-id "http://test-tm/")
+ (revision-1 100)
+ (document-id "doc-id")
+ (doc-1
+ (concatenate 'string "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" "
+ "xmlns:arcs=\"http://test/arcs/\" "
+ "xmlns:rdfs=\"" *rdfs-ns* "\">"
+ "<rdf:Description1 rdf:about=\"first-node\">"
+ "<rdf:type rdf:nodeID=\"second-node\"/>"
+ "<arcs:arc1 rdf:resource=\"third-node\"/>"
+ "<arcs:arc2 rdf:datatype=\"long\">123</arcs:arc2>"
+ "<arcs:arc3>"
+ "<rdf:Description3>"
+ "<arcs:arc4 rdf:parseType=\"Collection\">"
+ "<rdf:Description4 rdf:about=\"item-1\"/>"
+ "<rdf:Description5 rdf:about=\"item-2\">"
+ "<arcs:arc5 rdf:parseType=\"Resource\">"
+ "<arcs:arc7 rdf:resource=\"fourth-node\"/>"
+ "<arcs:arc8 rdf:parseType=\"Collection\" />"
+ "</arcs:arc5>"
+ "</rdf:Description5>"
+ "</arcs:arc4>"
+ "</rdf:Description3>"
+ "</arcs:arc3>"
+ "</rdf:Description1>"
+ "<rdf:Description2 rdf:nodeID=\"second-node\" />"
+ "</rdf:RDF>")))
+ (let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder))))
+ (is-true dom-1)
+ (is (= (length (dom:child-nodes dom-1)) 1))
+ (rdf-init-db :db-dir db-dir :start-revision revision-1)
+ (let ((rdf-node (elt (dom:child-nodes dom-1) 0)))
+ (is (= (length (dom:child-nodes rdf-node)) 2))
+ (rdf-importer::import-dom rdf-node revision-1 :tm-id tm-id
+ :document-id document-id)))))
+
+
(defun run-rdf-importer-tests()
(it.bese.fiveam:run! 'test-get-literals-of-node)
@@ -1445,4 +1486,5 @@
(it.bese.fiveam:run! 'test-get-associations-of-node-content)
(it.bese.fiveam:run! 'test-parse-properties-of-node)
(it.bese.fiveam:run! 'test-import-node-1)
- (it.bese.fiveam:run! 'test-import-node-reification))
\ No newline at end of file
+ (it.bese.fiveam:run! 'test-import-node-reification)
+ (it.bese.fiveam:run! 'test-import-dom))
\ 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 Wed Aug 5 06:53:45 2009
@@ -78,6 +78,7 @@
(defun import-dom (rdf-dom start-revision
&key (tm-id nil) (document-id *document-id*))
"Imports the entire dom of a rdf-xml-file."
+ (setf *_n-map* nil) ;in case of an failed last call
(tm-id-p tm-id "import-dom")
(let ((xml-base (get-xml-base rdf-dom))
(xml-lang (get-xml-lang rdf-dom))
@@ -85,29 +86,33 @@
(elem-ns (dom:namespace-uri rdf-dom)))
(if (and (string= elem-ns *rdf-ns*)
(string= elem-name "RDF"))
- (let ((children (child-nodes-or-text rdf-dom)))
+ (let ((children (child-nodes-or-text rdf-dom :trim t)))
(when children
(loop for child across children
do (import-node child tm-id start-revision :document-id document-id
:xml-base xml-base :xml-lang xml-lang))))
(import-node rdf-dom tm-id start-revision :document-id document-id
- :xml-base xml-base :xml-lang xml-lang))))
+ :xml-base xml-base :xml-lang xml-lang)))
+ (setf *_n-map* nil))
(defun import-node (elem tm-id start-revision &key (document-id *document-id*)
(xml-base nil) (xml-lang nil))
- (remove-node-properties-from-*_n-map* elem) ;in case of an failed last call
+ (format t ">> import-node: ~a <<~%" (dom:node-name elem))
(tm-id-p tm-id "import-node")
(parse-node elem)
- (let ((fn-xml-base (get-xml-base elem :old-base xml-base)))
+ ;TODO: handle Collections that are made manually without
+ ; parseType="Collection" -> see also import-arc
+ (let ((fn-xml-base (get-xml-base elem :old-base xml-base))
+ (fn-xml-lang (get-xml-lang elem :old-lang xml-lang)))
(parse-properties-of-node elem)
(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"))
(UUID (get-ns-attribute elem "UUID" :ns-uri *rdf2tm-ns*))
- (literals (append (get-literals-of-node elem xml-lang)
- (get-literals-of-node-content elem tm-id
- xml-base xml-lang)))
+ (literals (append (get-literals-of-node elem fn-xml-lang)
+ (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
@@ -123,51 +128,164 @@
(get-super-classes-of-node-content elem tm-id xml-base)))
(with-tm (start-revision document-id tm-id)
(elephant:ensure-transaction (:txn-nosync t)
- (let ((topic-stub
+ (let ((this
(make-topic-stub
about ID nodeID UUID start-revision xml-importer::tm
:document-id document-id)))
- (map 'list #'(lambda(literal)
- (make-occurrence topic-stub literal start-revision
- tm-id :document-id document-id))
- literals)
- (map 'list #'(lambda(assoc)
- (make-association topic-stub assoc xml-importer::tm
- start-revision
- :document-id document-id))
- associations)
- (map 'list
- #'(lambda(type)
- (let ((type-topic
- (make-topic-stub (getf type :psi)
- nil
- (getf type :topicid)
- nil start-revision
- xml-importer::tm
- :document-id document-id))
- (ID (getf type :ID)))
- (make-instance-of-association topic-stub type-topic
- ID start-revision
- xml-importer::tm
- :document-id document-id)))
- types)
- (map 'list
- #'(lambda(class)
- (let ((class-topic
- (make-topic-stub (getf class :psi)
- nil
- (getf class :topicid)
- nil start-revision
- xml-importer::tm
- :document-id document-id))
- (ID (getf class :ID)))
- (make-supertype-subtype-association
- topic-stub class-topic ID start-revision
- xml-importer::tm :document-id document-id)))
- super-classes)
-
- ;TODO: start recursion ...
- (remove-node-properties-from-*_n-map* elem)))))))
+ (make-literals this literals tm-id start-revision
+ :document-id document-id)
+ (make-associations this associations xml-importer::tm
+ start-revision :document-id document-id)
+ (make-types this types xml-importer::tm start-revision
+ :document-id document-id)
+ (make-super-classes this super-classes xml-importer::tm
+ start-revision :document-id document-id)
+ (make-recursion-from-node elem tm-id start-revision
+ :document-id document-id
+ :xml-base xml-base
+ :xml-lang xml-lang)
+ (remove-node-properties-from-*_n-map* elem)
+ this))))))
+
+
+(defun import-arc (elem tm-id start-revision
+ &key (document-id *document-id*)
+ (xml-base nil) (xml-lang nil))
+ "Imports a property that is an blank_node and continues the recursion
+ on this element."
+ (declare (dom:element elem))
+ (format t ">> import-arc: ~a <<~%" (dom:node-name elem))
+ (let ((fn-xml-lang (get-xml-lang elem :old-lang xml-lang))
+ (fn-xml-base (get-xml-base elem :old-base xml-base))
+ (UUID (get-ns-attribute elem "UUID" :ns-uri *rdf2tm-ns*))
+ (parseType (get-ns-attribute elem "parseType")))
+ (when (or (not parseType)
+ (and parseType
+ (string/= parseType "Collection")))
+ (when UUID
+ (parse-properties-of-node elem)
+ (with-tm (start-revision document-id tm-id)
+ (let ((this (get-item-by-id UUID :xtm-id document-id
+ :revision start-revision)))
+ (let ((literals (append (get-literals-of-node elem fn-xml-lang)
+ (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 (get-types-of-node-content elem tm-id fn-xml-base))
+ (super-classes
+ (get-super-classes-of-node-content elem tm-id xml-base)))
+ (make-literals this literals tm-id start-revision
+ :document-id document-id)
+ (make-associations this associations xml-importer::tm
+ start-revision :document-id document-id)
+ (make-types this types xml-importer::tm start-revision
+ :document-id document-id)
+ (make-super-classes this super-classes xml-importer::tm
+ start-revision :document-id document-id))))))
+ (make-recursion-from-arc elem tm-id start-revision
+ :document-id document-id
+ :xml-base xml-base :xml-lang xml-lang)))
+
+
+(defun make-collection (elem owner-top tm-id start-revision
+ &key (document-id *document-id*)
+ (xml-base nil) (xml-lang nil))
+ "Creates a TM association with a subject role containing the collection
+ entry point and as many roles of the type 'object' as items exists."
+ (declare (d:TopicC owner-top))
+ (with-tm (start-revision document-id tm-id)
+ (let ((fn-xml-base (get-xml-base elem :old-base xml-base))
+ (fn-xml-lang (get-xml-lang elem :old-lang xml-lang))
+ (subject (make-topic-stub *rdf2tm-subject* nil nil nil start-revision
+ xml-importer::tm :document-id document-id))
+ (object (make-topic-stub *rdf2tm-object* nil nil nil start-revision
+ xml-importer::tm :document-id document-id)))
+ (let ((association-type (make-topic-stub *rdf2tm-collection* nil nil nil
+ start-revision xml-importer::tm
+ :document-id document-id))
+ (roles
+ (append
+ (loop for item across (child-nodes-or-text elem :trim t)
+ collect (let ((item-top (import-node item tm-id start-revision
+ :document-id document-id
+ :xml-base fn-xml-base
+ :xml-lang fn-xml-lang)))
+ (list :player item-top
+ :instance-of object)))
+ (list (list :player owner-top
+ :instance-of subject)))))
+ (add-to-topicmap
+ xml-importer::tm
+ (make-construct 'd:AssociationC
+ :start-revision start-revision
+ :instance-of association-type
+ :roles roles))))))
+
+
+(defun make-literals (owner-top literals tm-id start-revision
+ &key (document-id *document-id*))
+ "Creates Topic Maps constructs (occurrences) of the passed
+ named list literals related to the topic owner-top."
+ (declare (d:TopicC owner-top))
+ (map 'list #'(lambda(literal)
+ (make-occurrence owner-top literal start-revision
+ tm-id :document-id document-id))
+ literals))
+
+
+(defun make-associations (owner-top associations tm start-revision
+ &key (document-id *document-id*))
+ "Creates Topic Maps constructs (assocaitions) of the passed
+ named list literals related to the topic owner-top."
+ (declare (d:TopicC owner-top))
+ (map 'list #'(lambda(assoc)
+ (make-association owner-top assoc tm
+ start-revision
+ :document-id document-id))
+ associations))
+
+
+(defun make-types (owner-top types tm start-revision
+ &key (document-id *document-id*))
+ "Creates instance-of associations corresponding to the passed
+ topic owner-top and the passed types."
+ (declare (d:TopicC owner-top))
+ (map 'list
+ #'(lambda(type)
+ (let ((type-topic
+ (make-topic-stub (getf type :psi)
+ nil
+ (getf type :topicid)
+ nil start-revision tm
+ :document-id document-id))
+ (ID (getf type :ID)))
+ (make-instance-of-association owner-top type-topic
+ ID start-revision tm
+ :document-id document-id)))
+ types))
+
+
+(defun make-super-classes (owner-top super-classes tm start-revision
+ &key (document-id *document-id*))
+ "Creates supertype-subtype associations corresponding to the passed
+ topic owner-top and the passed super classes."
+ (declare (d:TopicC owner-top))
+ (map 'list
+ #'(lambda(class)
+ (let ((class-topic
+ (make-topic-stub (getf class :psi)
+ nil
+ (getf class :topicid)
+ nil start-revision tm
+ :document-id document-id))
+ (ID (getf class :ID)))
+ (make-supertype-subtype-association
+ owner-top class-topic ID start-revision tm
+ :document-id document-id)))
+ super-classes))
+
+
(defun make-supertype-subtype-association (sub-top super-top reifier-id
@@ -176,9 +294,15 @@
"Creates an supertype-subtype association."
(declare (TopicC sub-top super-top))
(declare (TopicMapC tm))
- (let ((assoc-type (get-item-by-psi *supertype-subtype-psi*))
- (role-type-1 (get-item-by-psi *supertype-psi*))
- (role-type-2 (get-item-by-psi *subtype-psi*))
+ (let ((assoc-type
+ (make-topic-stub *supertype-subtype-psi* nil nil nil
+ start-revision tm :document-id document-id))
+ (role-type-1
+ (make-topic-stub *supertype-psi* nil nil nil
+ start-revision tm :document-id document-id))
+ (role-type-2
+ (make-topic-stub *subtype-psi* nil nil nil
+ start-revision tm :document-id document-id))
(err-pref "From make-supertype-subtype-association(): "))
(unless assoc-type
(error "~athe association type ~a is missing!"
@@ -210,11 +334,14 @@
(declare (TopicC type-top instance-top))
(declare (TopicMapC tm))
(let ((assoc-type
- (get-item-by-psi *type-instance-psi*))
+ (make-topic-stub *type-instance-psi* nil nil nil
+ start-revision tm :document-id document-id))
(roletype-1
- (get-item-by-psi *type-psi*))
+ (make-topic-stub *type-psi* nil nil nil
+ start-revision tm :document-id document-id))
(roletype-2
- (get-item-by-psi *instance-psi*))
+ (make-topic-stub *instance-psi* nil nil nil
+ start-revision tm :document-id document-id))
(err-pref "From make-instance-of-association(): "))
(unless assoc-type
(error "~athe association type ~a is missing!"
@@ -266,13 +393,15 @@
(make-instance 'PersistentIdC
:uri psi-uri
:start-revision start-revision))))
- (add-to-topicmap
- tm
- (make-construct 'TopicC
- :topicid topic-id
- :psis (when psi (list psi))
- :xtm-id document-id
- :start-revision start-revision))))))))
+ (handler-case (add-to-topicmap
+ tm
+ (make-construct 'TopicC
+ :topicid topic-id
+ :psis (when psi (list psi))
+ :xtm-id document-id
+ :start-revision start-revision))
+ (Condition (err)(error "Creating topic ~a failed: ~a"
+ topic-id err)))))))))
(defun make-lang-topic (lang tm-id start-revision tm
@@ -306,8 +435,12 @@
(let ((player-1 (make-topic-stub player-psi nil player-id nil
start-revision
tm :document-id document-id))
- (role-type-1 (get-item-by-psi *rdf2tm-object*))
- (role-type-2 (get-item-by-psi *rdf2tm-subject*))
+ (role-type-1
+ (make-topic-stub *rdf2tm-object* nil nil nil
+ start-revision tm :document-id document-id))
+ (role-type-2
+ (make-topic-stub *rdf2tm-subject* nil nil nil
+ start-revision tm :document-id document-id))
(type-top (make-topic-stub type nil nil nil start-revision
tm :document-id document-id)))
(let ((roles (list (list :instance-of role-type-1
@@ -324,12 +457,17 @@
(defun make-association-with-nodes (subject-topic object-topic
- associationtype-topic tm start-revision)
+ associationtype-topic tm start-revision
+ &key (document-id *document-id*))
"Creates an association with two roles that contains the given players."
(declare (TopicC subject-topic object-topic associationtype-topic))
(declare (TopicMapC tm))
- (let ((role-type-1 (get-item-by-psi *rdf2tm-subject*))
- (role-type-2 (get-item-by-psi *rdf2tm-object*)))
+ (let ((role-type-1
+ (make-topic-stub *rdf2tm-subject* nil nil nil start-revision
+ tm :document-id document-id))
+ (role-type-2
+ (make-topic-stub *rdf2tm-object* nil nil nil start-revision
+ tm :document-id document-id)))
(let ((roles (list (list :instance-of role-type-1
:player subject-topic)
(list :instance-of role-type-2
@@ -363,12 +501,13 @@
(make-instance-of-association reifier statement nil start-revision tm
:document-id document-id)
(make-association-with-nodes reifier subject subject-arc tm
- start-revision)
+ start-revision :document-id document-id)
(make-association-with-nodes reifier predicate predicate-arc
- tm start-revision)
+ tm start-revision :document-id document-id)
(if (typep object 'd:TopicC)
(make-association-with-nodes reifier object object-arc
- tm start-revision)
+ tm start-revision
+ :document-id document-id)
(make-construct 'd:OccurrenceC
:start-revision start-revision
:topic reifier
@@ -416,7 +555,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-content")
- (let ((properties (child-nodes-or-text node))
+ (let ((properties (child-nodes-or-text node :trim t))
(fn-xml-base (get-xml-base node :old-base xml-base))
(fn-xml-lang (get-xml-lang node :old-lang xml-lang)))
(let ((literals
@@ -486,8 +625,8 @@
:ID nil))
nil))
(content-types
- (when (child-nodes-or-text node)
- (loop for child across (child-nodes-or-text node)
+ (when (child-nodes-or-text node :trim t)
+ (loop for child across (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"))
@@ -505,7 +644,7 @@
(get-xml-base child :old-base fn-xml-base)))
(let ((refs
(get-node-refs
- (child-nodes-or-text child)
+ (child-nodes-or-text child :trim t)
tm-id child-xml-base)))
(list :topicid (getf (first refs) :topicid)
:psi (getf (first refs) :psi)
@@ -601,7 +740,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))
+ (let ((content (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
@@ -624,7 +763,7 @@
:psi resource
:ID ID)
(let ((refs (get-node-refs
- (child-nodes-or-text property)
+ (child-nodes-or-text property :trim t)
tm-id prop-xml-base)))
(list :topicid (getf (first refs) :topicid)
:psi (getf (first refs) :psi)
@@ -634,7 +773,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))
+ (let ((properties (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))
@@ -675,9 +814,68 @@
:psi resource
:ID ID)
(let ((refs (get-node-refs
- (child-nodes-or-text property)
+ (child-nodes-or-text property :trim t)
tm-id prop-xml-base)))
(list :type full-name
:topicid (getf (first refs) :topicid)
:psi (getf (first refs) :psi)
- :ID ID))))))))
\ No newline at end of file
+ :ID ID))))))))
+
+
+(defun make-recursion-from-node (node tm-id start-revision
+ &key (document-id *document-id*)
+ (xml-base nil) (xml-lang nil))
+ "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))
+ (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)))
+ (when (stringp content)
+ (error "~aliteral content not allowed here: ~a"
+ err-pref content))
+ (loop for arc across content
+ do (import-arc arc tm-id start-revision :document-id document-id
+ :xml-base fn-xml-base :xml-lang fn-xml-lang))))
+
+
+(defun make-recursion-from-arc (arc tm-id start-revision
+ &key (document-id *document-id*)
+ (xml-base nil) (xml-lang nil))
+ "Calls the next function that handles the arcs content nodes/arcs."
+ (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))
+ (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"))
+ (resource (get-absolute-attribute arc tm-id xml-base "resource"))
+ (nodeID (get-ns-attribute arc "nodeID"))
+ (literals (get-literals-of-property arc xml-lang)))
+ (if (and parseType
+ (string= parseType "Collection"))
+ (loop for item across content
+ do (import-node item tm-id start-revision :document-id document-id
+ :xml-base fn-xml-base :xml-lang fn-xml-lang))
+ (if (or datatype resource nodeID
+ (and parseType
+ (string= parseType "Literal"))
+ (and content
+ (stringp content)))
+ t;; do nothing current elem is a literal node that has been
+ ;; already imported as an occurrence
+ (if (or type literals
+ (and parseType
+ (string= parseType "Resource")))
+ (loop for item across content
+ do (import-arc item tm-id start-revision
+ :document-id document-id
+ :xml-base fn-xml-base
+ :xml-lang fn-xml-lang))
+ (loop for item across content
+ do (import-node item tm-id start-revision
+ :document-id document-id
+ :xml-base xml-base
+ :xml-lang xml-lang))))))))
Modified: trunk/src/xml/rdf/rdf_tools.lisp
==============================================================================
--- trunk/src/xml/rdf/rdf_tools.lisp (original)
+++ trunk/src/xml/rdf/rdf_tools.lisp Wed Aug 5 06:53:45 2009
@@ -27,7 +27,11 @@
*rdf2tm-subject*
*supertype-psi*
*subtype-psi*
- *supertype-subtype-psi*)
+ *supertype-subtype-psi*
+ *rdf-nil*
+ *rdf-first*
+ *rdf-rest*
+ *rdf2tm-collection*)
(:import-from :xml-constants
*rdf_core_psis.xtm*)
(:import-from :xml-constants
@@ -132,7 +136,7 @@
(defun remove-node-properties-from-*_n-map* (node)
"Removes all node's properties from the list *_n-map*."
(declare (dom:element node))
- (let ((properties (child-nodes-or-text node)))
+ (let ((properties (child-nodes-or-text node :trim t)))
(when properties
(loop for property across properties
do (unset-_n-name property))))
@@ -203,7 +207,7 @@
(or about nodeID))
(error "~awhen rdf:ID is set the attributes rdf:~a is not allowed: ~a!"
err-pref (if about "about" "nodeID") (or about nodeID)))
- (unless (or ID nodeID about)
+ (unless (or ID nodeID about (dom:has-attribute-ns node *rdf2tm-ns* "UUID"))
(dom:set-attribute-ns node *rdf2tm-ns* "UUID" (get-uuid)))
(handler-case (let ((content (child-nodes-or-text node :trim t)))
(when (stringp content)
@@ -320,7 +324,8 @@
(when (and parseType
(or (string= parseType "Resource")
(string= parseType "Collection")))
- (dom:set-attribute-ns property *rdf2tm-ns* "UUID" (get-uuid)))
+ (unless (dom:has-attribute-ns property *rdf2tm-ns* "UUID")
+ (dom:set-attribute-ns property *rdf2tm-ns* "UUID" (get-uuid))))
(when (and parseType (string= parseType "Resource") (stringp content))
(error "~ardf:parseType is set to 'Resource' expecting xml content: ~a!"
err-pref content))
@@ -356,7 +361,8 @@
(> (length literals) 0))
(not (or nodeID resource))
(not content))
- (dom:set-attribute-ns property *rdf2tm-ns* "UUID" (get-uuid)))
+ (unless (dom:has-attribute-ns property *rdf2tm-ns* "UUID")
+ (dom:set-attribute-ns property *rdf2tm-ns* "UUID" (get-uuid))))
(when (or about subClassOf)
(error "~a~a not allowed here!"
err-pref
@@ -366,7 +372,8 @@
(when (and (string= node-name "subClassOf")
(string= node-ns *rdfs-ns*)
(not (or nodeID resource content)))
- (dom:set-attribute-ns property *rdf2tm-ns* "UUID" (get-uuid)))
+ (unless (dom:has-attribute-ns property *rdf2tm-ns* "UUID")
+ (dom:set-attribute-ns property *rdf2tm-ns* "UUID" (get-uuid))))
(when (and (or (and (string= node-name "type")
(string= node-ns *rdf-ns*))
(and (string= node-name "subClassOf")
@@ -393,7 +400,7 @@
"Parses all node's properties by calling the parse-propery
function and sets all rdf:li properties as a tupple to the
*_n-map* list."
- (let ((child-nodes (child-nodes-or-text node))
+ (let ((child-nodes (child-nodes-or-text node :trim t))
(_n-counter 0))
(when (get-ns-attribute node "li")
(dom:map-node-map
@@ -436,5 +443,4 @@
(get-absolute-attribute elem tm-id fn-xml-base "datatype")))
(if datatype
datatype
- *xml-string*))))
-
\ No newline at end of file
+ *xml-string*))))
\ No newline at end of file
1
0
Author: lgiessmann
Date: Tue Aug 4 03:48:16 2009
New Revision: 105
Log:
added unit tests for rdf-reification; currently reification is not mapped directly into topic maps, the rdf:id attribute is mapped into special nodes with special arcs, described in rdf/xml which are mapped into topic maps
Modified:
trunk/src/unit_tests/rdf_importer_test.lisp
Modified: trunk/src/unit_tests/rdf_importer_test.lisp
==============================================================================
--- trunk/src/unit_tests/rdf_importer_test.lisp (original)
+++ trunk/src/unit_tests/rdf_importer_test.lisp Tue Aug 4 03:48:16 2009
@@ -31,7 +31,8 @@
*rdf2tm-subject*
*rdf-subject*
*rdf-object*
- *rdf-predicate*)
+ *rdf-predicate*
+ *rdf-statement*)
(:import-from :xml-tools
xpath-child-elems-by-qname
xpath-single-child-elem-by-qname
@@ -1240,8 +1241,196 @@
(rdf-importer::import-node (elt (dom:child-nodes rdf-node) iter)
tm-id revision-1
:document-id document-id))
-
- ))))
+ (let ((reification-1 (d:get-item-by-id "http://test-tm#reification-1"
+ :xtm-id document-id))
+ (reification-2 (d:get-item-by-id "http://test-tm#reification-2"
+ :xtm-id document-id))
+ (first-node (d:get-item-by-id "http://test-tm/first-node"
+ :xtm-id document-id))
+ (second-node (d:get-item-by-id "http://test-tm/second-node"
+ :xtm-id document-id))
+ (third-node (d:get-item-by-id "http://test-tm/third-node"
+ :xtm-id document-id))
+ (fourth-node (d:get-item-by-id "fourth-node"
+ :xtm-id document-id))
+ (fifth-node (d:get-item-by-id "http://test-tm/fifth-node"
+ :xtm-id document-id))
+ (arc1 (d:get-item-by-id "http://test/arcs/arc1"
+ :xtm-id document-id))
+ (arc2 (d:get-item-by-id "http://test/arcs/arc2"
+ :xtm-id document-id))
+ (arc3 (d:get-item-by-id "http://test/arcs/arc3"
+ :xtm-id document-id))
+ (arc4 (d:get-item-by-id "http://test/arcs/arc4"
+ :xtm-id document-id))
+ (statement (d:get-item-by-psi *rdf-statement*))
+ (object (d:get-item-by-psi *rdf-object*))
+ (subject (d:get-item-by-psi *rdf-subject*))
+ (predicate (d:get-item-by-psi *rdf-predicate*))
+ (type (d:get-item-by-psi *type-psi*))
+ (instance (d:get-item-by-psi *instance-psi*))
+ (type-instance (d:get-item-by-psi *type-instance-psi*))
+ (isi-subject (d:get-item-by-psi *rdf2tm-subject*))
+ (isi-object (d:get-item-by-psi *rdf2tm-object*)))
+ (is (= (length (d:psis reification-1)) 1))
+ (is (string= (d:uri (first (d:psis reification-1)))
+ "http://test-tm#reification-1"))
+ (is (= (length (d:psis reification-2)) 1))
+ (is (string= (d:uri (first (d:psis reification-2)))
+ "http://test-tm#reification-2"))
+ (is (= (length (d:psis first-node)) 1))
+ (is (string= (d:uri (first (d:psis first-node)))
+ "http://test-tm/first-node"))
+ (is (= (length (d:psis second-node)) 1))
+ (is (string= (d:uri (first (d:psis second-node)))
+ "http://test-tm/second-node"))
+ (is (= (length (d:psis third-node)) 1))
+ (is (string= (d:uri (first (d:psis third-node)))
+ "http://test-tm/third-node"))
+ (is (= (length (d:psis fourth-node)) 0))
+ (is (= (length (d:psis fifth-node)) 1))
+ (is (string= (d:uri (first (d:psis fifth-node)))
+ "http://test-tm/fifth-node"))
+ (is (= (length (d:psis arc1)) 1))
+ (is (string= (d:uri (first (d:psis arc1)))
+ "http://test/arcs/arc1"))
+ (is (= (length (d:psis arc2))))
+ (is (string= (d:uri (first (d:psis arc2)))
+ "http://test/arcs/arc2"))
+ (is (= (length (d:psis arc3))))
+ (is (string= (d:uri (first (d:psis arc3)))
+ "http://test/arcs/arc3"))
+ (is (= (length (d:psis arc4))))
+ (is (string= (d:uri (first (d:psis arc4)))
+ "http://test/arcs/arc4"))
+ (is-true statement)
+ (is-true object)
+ (is-true subject)
+ (is-true predicate)
+ (is-true type)
+ (is-true instance)
+ (is-true type-instance)
+ (is (= (length (d:player-in-roles first-node)) 2))
+ (is-true (find-if #'(lambda(x)
+ (and (eql (d:instance-of x) isi-subject)
+ (eql (d:instance-of (d:parent x)) arc1)))
+ (d:player-in-roles first-node)))
+ (is-true (find-if #'(lambda(x)
+ (and (eql (d:instance-of x) isi-object)
+ (eql (d:instance-of (d:parent x))
+ subject)))
+ (d:player-in-roles first-node)))
+ (is (= (length (d:player-in-roles second-node)) 2))
+ (is-true (find-if #'(lambda(x)
+ (and (eql (d:instance-of x) isi-object)
+ (eql (d:instance-of (d:parent x)) arc1)))
+ (d:player-in-roles second-node)))
+ (is-true (find-if #'(lambda(x)
+ (and (eql (d:instance-of x) isi-object)
+ (eql (d:instance-of (d:parent x))
+ object)))
+ (d:player-in-roles second-node)))
+ (is (= (length (d:player-in-roles statement)) 2))
+ (is-true (find-if #'(lambda(x)
+ (and (eql (d:instance-of x) type)
+ (eql (d:instance-of (d:parent x))
+ type-instance)))
+ (d:player-in-roles statement)))
+ (is (= (length (d:player-in-roles arc1)) 1))
+ (is-true (find-if #'(lambda(x)
+ (and (eql (d:instance-of x) isi-object)
+ (eql (d:instance-of (d:parent x))
+ predicate)))
+ (d:player-in-roles arc1)))
+ (is (= (length (d:player-in-roles third-node)) 1))
+ (is-true (find-if #'(lambda(x)
+ (and (eql (d:instance-of x) isi-object)
+ (eql (d:instance-of (d:parent x))
+ arc2)))
+ (d:player-in-roles third-node)))
+ (is (= (length (d:player-in-roles reification-1)) 5))
+ (is-true (find-if #'(lambda(x)
+ (and (eql (d:instance-of x) isi-subject)
+ (eql (d:instance-of (d:parent x))
+ subject)))
+ (d:player-in-roles reification-1)))
+ (is-true (find-if #'(lambda(x)
+ (and (eql (d:instance-of x) isi-subject)
+ (eql (d:instance-of (d:parent x))
+ object)))
+ (d:player-in-roles reification-1)))
+ (is-true (find-if #'(lambda(x)
+ (and (eql (d:instance-of x) instance)
+ (eql (d:instance-of (d:parent x))
+ type-instance)))
+ (d:player-in-roles reification-1)))
+ (is-true (find-if #'(lambda(x)
+ (and (eql (d:instance-of x) isi-subject)
+ (eql (d:instance-of (d:parent x))
+ object)))
+ (d:player-in-roles reification-1)))
+ (is-true (find-if #'(lambda(x)
+ (and (eql (d:instance-of x) isi-subject)
+ (eql (d:instance-of (d:parent x))
+ predicate)))
+ (d:player-in-roles reification-1)))
+ (is-true (find-if #'(lambda(x)
+ (and (eql (d:instance-of x) isi-subject)
+ (eql (d:instance-of (d:parent x))
+ arc2)))
+ (d:player-in-roles reification-1)))
+ (is (= (length (d:occurrences fourth-node)) 1))
+ (is (string= (d:charvalue (first (d:occurrences fourth-node)))
+ "occurrence data"))
+ (is (string= (d:datatype (first (d:occurrences fourth-node)))
+ "http://test-tm/dt"))
+ (is (eql (d:instance-of (first (d:occurrences fourth-node)))
+ arc3))
+ (is (= (length (d:player-in-roles fourth-node)) 1))
+ (is-true (find-if #'(lambda(x)
+ (and (eql (d:instance-of x) isi-object)
+ (eql (d:instance-of (d:parent x))
+ subject)))
+ (d:player-in-roles fourth-node)))
+ (is (= (length (d:player-in-roles arc3)) 1))
+ (is-true (find-if #'(lambda(x)
+ (and (eql (d:instance-of x) isi-object)
+ (eql (d:instance-of (d:parent x))
+ predicate)))
+ (d:player-in-roles arc3)))
+ (is (= (length (d:player-in-roles fifth-node)) 1))
+ (is-true (find-if #'(lambda(x)
+ (and (eql (d:instance-of x) isi-object)
+ (eql (d:instance-of (d:parent x))
+ arc4)))
+ (d:player-in-roles fifth-node)))
+ (is (= (length (d:occurrences reification-2)) 1))
+ (is (string= (d:charvalue (first (d:occurrences reification-2)))
+ "occurrence data"))
+ (is (string= (d:datatype (first (d:occurrences reification-2)))
+ "http://test-tm/dt"))
+ (is (= (length (d:player-in-roles reification-2)) 4))
+ (is-true (find-if #'(lambda(x)
+ (and (eql (d:instance-of x) isi-subject)
+ (eql (d:instance-of (d:parent x))
+ subject)))
+ (d:player-in-roles reification-2)))
+ (is-true (find-if #'(lambda(x)
+ (and (eql (d:instance-of x) isi-subject)
+ (eql (d:instance-of (d:parent x))
+ predicate)))
+ (d:player-in-roles reification-2)))
+ (is-true (find-if #'(lambda(x)
+ (and (eql (d:instance-of x) isi-subject)
+ (eql (d:instance-of (d:parent x))
+ arc4)))
+ (d:player-in-roles reification-2)))
+ (is-true (find-if #'(lambda(x)
+ (and (eql (d:instance-of x) instance)
+ (eql (d:instance-of (d:parent x))
+ type-instance)))
+ (d:player-in-roles reification-2)))
+ (elephant:close-store))))))
1
0
Author: lgiessmann
Date: Mon Aug 3 15:00:53 2009
New Revision: 104
Log:
fixed a bug in the rdf-importer module which affects reification of arcs contains literal content
Modified:
trunk/src/unit_tests/rdf_importer_test.lisp
trunk/src/xml/rdf/importer.lisp
Modified: trunk/src/unit_tests/rdf_importer_test.lisp
==============================================================================
--- trunk/src/unit_tests/rdf_importer_test.lisp (original)
+++ trunk/src/unit_tests/rdf_importer_test.lisp Mon Aug 3 15:00:53 2009
@@ -1203,8 +1203,45 @@
(test test-import-node-reification
-
- )
+ "Tests the function import-node non-recursively. Especially the reification
+ of association- and occurrence-arcs."
+ (let ((db-dir "data_base")
+ (tm-id "http://test-tm/")
+ (revision-1 100)
+ (document-id "doc-id")
+ (doc-1
+ (concatenate 'string "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" "
+ "xmlns:arcs=\"http://test/arcs/\" "
+ "xmlns:rdfs=\"" *rdfs-ns* "\">"
+ "<rdf:Description rdf:about=\"first-node\">"
+ "<arcs:arc1 rdf:ID=\"reification-1\">"
+ "<rdf:Description rdf:about=\"second-node\" />"
+ "</arcs:arc1>"
+ "</rdf:Description>"
+ "<rdf:Description rdf:ID=\"#reification-1\">"
+ "<arcs:arc2 rdf:resource=\"third-node\"/>"
+ "</rdf:Description>"
+ "<rdf:Description rdf:nodeID=\"fourth-node\">"
+ "<arcs:arc3 rdf:ID=\"reification-2\" rdf:datatype=\"dt\">"
+ "occurrence data"
+ "</arcs:arc3>"
+ "</rdf:Description>"
+ "<rdf:Description rdf:ID=\"#reification-2\">"
+ "<arcs:arc4 rdf:resource=\"fifth-node\" />"
+ "</rdf:Description>"
+ "</rdf:RDF>")))
+ (let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder))))
+ (is-true dom-1)
+ (is (= (length (dom:child-nodes dom-1)) 1))
+ (let ((rdf-node (elt (dom:child-nodes dom-1) 0)))
+ (is (= (length (dom:child-nodes rdf-node)) 4))
+ (rdf-init-db :db-dir db-dir :start-revision revision-1)
+ (dotimes (iter (length (dom:child-nodes rdf-node)))
+ (rdf-importer::import-node (elt (dom:child-nodes rdf-node) iter)
+ tm-id revision-1
+ :document-id document-id))
+
+ ))))
Modified: trunk/src/xml/rdf/importer.lisp
==============================================================================
--- trunk/src/xml/rdf/importer.lisp (original)
+++ trunk/src/xml/rdf/importer.lisp Mon Aug 3 15:00:53 2009
@@ -315,7 +315,7 @@
(list :instance-of role-type-2
:player top))))
(when ID
- (make-reification ID top type-top player-1 start-revision
+ (make-reification ID top player-1 type-top start-revision
tm :document-id document-id))
(add-to-topicmap tm (make-construct 'AssociationC
:start-revision start-revision
@@ -348,6 +348,7 @@
(declare ((or OccurrenceC TopicC) object))
(declare (TopicC subject predicate))
(declare (TopicMapC tm))
+
(let ((reifier (make-topic-stub reifier-id nil nil nil start-revision tm
:document-id document-id))
(predicate-arc (make-topic-stub *rdf-predicate* nil nil nil start-revision
@@ -365,10 +366,10 @@
start-revision)
(make-association-with-nodes reifier predicate predicate-arc
tm start-revision)
- (if (typep object 'TopicC)
+ (if (typep object 'd:TopicC)
(make-association-with-nodes reifier object object-arc
tm start-revision)
- (make-construct 'OccurrenceC
+ (make-construct 'd:OccurrenceC
:start-revision start-revision
:topic reifier
:themes (themes object)
@@ -406,7 +407,7 @@
:charvalue value
:datatype datatype)))
(when ID
- (make-reification ID top type-top occurrence start-revision
+ (make-reification ID top occurrence type-top start-revision
xml-importer::tm :document-id document-id))
occurrence))))))
1
0
03 Aug '09
Author: lgiessmann
Date: Mon Aug 3 13:08:11 2009
New Revision: 103
Log:
added some unit tests for the rdf-importer and fixed several bugs
Modified:
trunk/src/unit_tests/rdf_importer_test.lisp
trunk/src/xml/rdf/importer.lisp
trunk/src/xml/rdf/rdf_core_psis.xtm
trunk/src/xml/rdf/rdf_tools.lisp
trunk/src/xml/xtm/tools.lisp
Modified: trunk/src/unit_tests/rdf_importer_test.lisp
==============================================================================
--- trunk/src/unit_tests/rdf_importer_test.lisp (original)
+++ trunk/src/unit_tests/rdf_importer_test.lisp Mon Aug 3 13:08:11 2009
@@ -19,7 +19,19 @@
*rdfs-ns*
*rdf2tm-ns*
*xml-ns*
- *xml-string*)
+ *xml-string*
+ *instance-psi*
+ *type-psi*
+ *type-instance-psi*
+ *subtype-psi*
+ *supertype-psi*
+ *supertype-subtype-psi*
+ *xml-string*
+ *rdf2tm-object*
+ *rdf2tm-subject*
+ *rdf-subject*
+ *rdf-object*
+ *rdf-predicate*)
(:import-from :xml-tools
xpath-child-elems-by-qname
xpath-single-child-elem-by-qname
@@ -36,7 +48,9 @@
:test-get-literals-of-content
:test-get-super-classes-of-node-content
:test-get-associations-of-node-content
- :test-parse-properties-of-node))
+ :test-parse-properties-of-node
+ :test-import-node-1
+ :test-import-node-reification))
(declaim (optimize (debug 3) (speed 0) (safety 3) (space 0) (compilation-speed 0)))
@@ -49,6 +63,16 @@
(in-suite rdf-importer-test)
+(defun rdf-init-db (&key (db-dir "data_base") (start-revision (get-revision)))
+ "Empties the data base files and initializes isidorus for rdf."
+ (when elephant:*store-controller*
+ (elephant:close-store))
+ (clean-out-db db-dir)
+ (elephant:open-store (xml-importer:get-store-spec db-dir))
+ (xml-importer:init-isidorus start-revision)
+ (rdf-importer:init-rdf-module start-revision))
+
+
(test test-get-literals-of-node
"Tests the helper function get-literals-of-node."
(let ((doc-1
@@ -967,7 +991,221 @@
(rdf-importer::remove-node-properties-from-*_n-map* node)
(is (= (length rdf-importer::*_n-map*) 0))))))
+
+(test test-import-node-1
+ "Tests the function import-node non-recursively."
+ (let ((db-dir "data_base")
+ (tm-id "http://test-tm/")
+ (revision-1 100)
+ (revision-2 200)
+ (revision-3 300)
+ (document-id "doc-id")
+ (doc-1
+ (concatenate 'string "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" "
+ "xmlns:arcs=\"http://test/arcs/\" "
+ "xmlns:rdfs=\"" *rdfs-ns* "\">"
+ "<rdf:Description rdf:about=\"first-node\">"
+ "<rdf:type rdf:resource=\"first-type\" />"
+ "</rdf:Description>"
+ "<rdf:Description rdf:type=\"second-type\" "
+ "rdf:nodeID=\"second-node\">"
+ "<rdfs:subClassOf>"
+ "<rdf:Description rdf:ID=\"third-node\" />"
+ "</rdfs:subClassOf>"
+ "</rdf:Description>"
+ "<rdf:Description arcs:arc1=\"arc-1\">"
+ "<arcs:arc2 rdf:datatype=\"dt\">arc-2</arcs:arc2>"
+ "</rdf:Description>"
+ "<rdf:Description rdf:about=\"fourth-node\">"
+ "<arcs:arc3 rdf:parseType=\"Literal\"><root>"
+ "<content type=\"anyContent\">content</content>"
+ "</root></arcs:arc3>"
+ "</rdf:Description>"
+ "<rdf:Description rdf:ID=\"fifth-node\">"
+ "<arcs:arc4 rdf:parseType=\"Resource\">"
+ "<arcs:arc5 rdf:resource=\"arc-5\" />"
+ "</arcs:arc4>"
+ "</rdf:Description>"
+ "</rdf:RDF>")))
+ (let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder))))
+ (is-true dom-1)
+ (is (= (length (dom:child-nodes dom-1)) 1))
+ (let ((rdf-node (elt (dom:child-nodes dom-1) 0)))
+ (is (= (length (dom:child-nodes rdf-node)) 5))
+ (let ((node (elt (dom:child-nodes rdf-node) 0)))
+ (rdf-init-db :db-dir db-dir :start-revision revision-1)
+ (rdf-importer::import-node node tm-id revision-2
+ :document-id document-id)
+ (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 20))
+ (let ((first-node (get-item-by-id "http://test-tm/first-node"
+ :xtm-id document-id))
+ (first-type (get-item-by-id "http://test-tm/first-type"
+ :xtm-id document-id)))
+ (is-true first-node)
+ (is (= (length (d::versions first-node)) 1))
+ (is (= (d::start-revision (first (d::versions first-node)))
+ revision-2))
+ (is (= (d::end-revision (first (d::versions first-node))) 0))
+ (is-true first-type)
+ (is (= (length (d:player-in-roles first-node)) 1))
+ (is (= (length (d:player-in-roles first-type)) 1))
+ (let ((instance-role
+ (first (d:player-in-roles first-node)))
+ (type-role
+ (first (d:player-in-roles first-type)))
+ (type-assoc
+ (d:parent (first (d:player-in-roles first-node)))))
+ (is (= (length (d::versions type-assoc)) 1))
+ (is (= (d::start-revision (first (d::versions type-assoc)))
+ revision-2))
+ (is (eql (d:instance-of instance-role)
+ (d:get-item-by-psi *instance-psi*)))
+ (is (eql (d:instance-of type-role)
+ (d:get-item-by-psi *type-psi*)))
+ (is (eql (d:instance-of type-assoc)
+ (d:get-item-by-psi *type-instance-psi*)))
+ (is (= (length (d:roles type-assoc)) 2))
+ (is (= (length (d:psis first-node)) 1))
+ (is (= (length (d:psis first-type)) 1))
+ (is (string= (d:uri (first (d:psis first-node)))
+ "http://test-tm/first-node"))
+ (is (string= (d:uri (first (d:psis first-type)))
+ "http://test-tm/first-type"))
+ (is (= (length (elephant:get-instances-by-class 'd:OccurrenceC))))
+ (is (= (length (elephant:get-instances-by-class 'd:NameC))))
+ (is (= (length (elephant:get-instances-by-class 'd:VariantC)))))
+ (dotimes (iter (length (dom:child-nodes rdf-node)))
+ (rdf-importer::import-node (elt (dom:child-nodes rdf-node) iter)
+ tm-id revision-3
+ :document-id document-id))
+ (let ((first-node (get-item-by-id "http://test-tm/first-node"
+ :xtm-id document-id))
+ (first-type (get-item-by-id "http://test-tm/first-type"
+ :xtm-id document-id))
+ (second-node (get-item-by-id "second-node"
+ :xtm-id document-id))
+ (second-type (get-item-by-id "http://test-tm/second-type"
+ :xtm-id document-id))
+ (third-node (get-item-by-id "http://test-tm#third-node"
+ :xtm-id document-id)))
+ (is-true second-node)
+ (is-false (d:psis second-node))
+ (is-false (d:occurrences second-node))
+ (is-false (d:names second-node))
+ (is-true first-node)
+ (is (= (length (d::versions first-node)) 2))
+ (is-true (find-if #'(lambda(x)
+ (and (= (d::start-revision x) revision-2)
+ (= (d::end-revision x) revision-3)))
+ (d::versions first-node)))
+ (is-true (find-if #'(lambda(x)
+ (and (= (d::start-revision x) revision-3)
+ (= (d::end-revision x) 0)))
+ (d::versions first-node)))
+ (let ((instance-role
+ (first (d:player-in-roles first-node)))
+ (type-role
+ (first (d:player-in-roles first-type)))
+ (type-assoc
+ (d:parent (first (d:player-in-roles first-node))))
+ (type-topic (get-item-by-psi *type-psi*))
+ (instance-topic (get-item-by-psi *instance-psi*))
+ (type-instance-topic (get-item-by-psi *type-instance-psi*))
+ (supertype-topic (get-item-by-psi *supertype-psi*))
+ (subtype-topic (get-item-by-psi *subtype-psi*))
+ (supertype-subtype-topic
+ (get-item-by-psi *supertype-subtype-psi*))
+ (arc2-occurrence (elephant:get-instance-by-value
+ 'd:OccurrenceC 'd:charvalue "arc-2"))
+ (arc3-occurrence
+ (elephant:get-instance-by-value
+ 'd:OccurrenceC 'd:charvalue
+ "<root><content type=\"anyContent\">content</content></root>"))
+ (fifth-node (d:get-item-by-id "http://test-tm#fifth-node"
+ :xtm-id document-id)))
+ (is (eql (d:instance-of instance-role)
+ (d:get-item-by-psi *instance-psi*)))
+ (is (eql (d:instance-of type-role)
+ (d:get-item-by-psi *type-psi*)))
+ (is (eql (d:instance-of type-assoc)
+ (d:get-item-by-psi *type-instance-psi*)))
+ (is (= (length (d:roles type-assoc)) 2))
+ (is (= (length (d:psis first-node)) 1))
+ (is (= (length (d:psis first-type)) 1))
+ (is (= (length (d::versions type-assoc)) 1))
+ (is (= (length (d:player-in-roles second-node)) 2))
+ (is-true (find-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) instance-topic)
+ (eql (d:instance-of (d:parent x) )
+ type-instance-topic)))
+ (d:player-in-roles second-node)))
+ (is-true (find-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) subtype-topic)
+ (eql (d:instance-of (d:parent x) )
+ supertype-subtype-topic)))
+ (d:player-in-roles second-node)))
+ (is-true (find-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) type-topic)
+ (eql (d:instance-of (d:parent x) )
+ type-instance-topic)))
+ (d:player-in-roles second-type)))
+ (is-true (find-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) supertype-topic)
+ (eql (d:instance-of (d:parent x) )
+ supertype-subtype-topic)))
+ (d:player-in-roles third-node)))
+ (is-true arc2-occurrence)
+ (is (string= (d:datatype arc2-occurrence) "http://test-tm/dt"))
+ (is-false (d:psis (d:topic arc2-occurrence)))
+ (is (= (length (d::versions (d:topic arc2-occurrence))) 1))
+ (is (= (d::start-revision
+ (first (d::versions (d:topic arc2-occurrence))))
+ revision-3))
+ (is (= (d::end-revision
+ (first (d::versions (d:topic arc2-occurrence)))) 0))
+ (is-true arc3-occurrence)
+ (is (= (length (d:psis (d:topic arc3-occurrence)))))
+ (is (string= (d:uri (first (d:psis (d:topic arc3-occurrence))))
+ "http://test-tm/fourth-node"))
+ (is (string= (d:datatype arc3-occurrence)
+ *xml-string*))
+ (is-true fifth-node)
+ (is (= (length (d:psis fifth-node)) 1))
+ (is (string= (d:uri (first (d:psis fifth-node)))
+ "http://test-tm#fifth-node"))
+ (is-false (d:occurrences fifth-node))
+ (is-false (d:names fifth-node))
+ (is (= (length (d:player-in-roles fifth-node))))
+ (let ((assoc (d:parent (first (d:player-in-roles
+ fifth-node)))))
+ (is-true assoc)
+ (let ((object-role
+ (find-if
+ #'(lambda(role)
+ (eql (d:instance-of role)
+ (d:get-item-by-psi *rdf2tm-object*)))
+ (d:roles assoc)))
+ (subject-role
+ (find-if
+ #'(lambda(role)
+ (eql (d:instance-of role)
+ (d:get-item-by-psi *rdf2tm-subject*)))
+ (d:roles assoc))))
+ (is-true object-role)
+ (is-true subject-role)
+ (is (eql (d:player subject-role) fifth-node))
+ (is-false (d:psis (d:player object-role))))))))))))
+ (elephant:close-store))
+
+(test test-import-node-reification
+
+ )
+
(defun run-rdf-importer-tests()
@@ -979,4 +1217,6 @@
(it.bese.fiveam:run! 'test-get-literals-of-content)
(it.bese.fiveam:run! 'test-get-super-classes-of-node-content)
(it.bese.fiveam:run! 'test-get-associations-of-node-content)
- (it.bese.fiveam:run! 'test-parse-properties-of-node))
\ No newline at end of file
+ (it.bese.fiveam:run! 'test-parse-properties-of-node)
+ (it.bese.fiveam:run! 'test-import-node-1)
+ (it.bese.fiveam:run! 'test-import-node-reification))
\ 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 3 13:08:11 2009
@@ -8,7 +8,7 @@
(in-package :rdf-importer)
-(defvar *document-id* nil)
+(defvar *document-id* "isidorus-rdf-document")
(defun setup-rdf-module (rdf-xml-path repository-path
@@ -37,15 +37,16 @@
"Imports the file correponding to the given path."
(setf *document-id* document-id)
(tm-id-p tm-id "rdf-importer")
- (unless elephant:*store-controller*
- (elephant:open-store
- (get-store-spec repository-path)))
- (let ((rdf-dom
- (dom:document-element (cxml:parse-file
- (truename rdf-xml-path)
- (cxml-dom:make-dom-builder)))))
- (import-dom rdf-dom start-revision :tm-id tm-id :document-id document-id))
- (setf *_n-map* nil))
+ (with-writer-lock
+ (unless elephant:*store-controller*
+ (elephant:open-store
+ (get-store-spec repository-path)))
+ (let ((rdf-dom
+ (dom:document-element (cxml:parse-file
+ (truename rdf-xml-path)
+ (cxml-dom:make-dom-builder)))))
+ (import-dom rdf-dom start-revision :tm-id tm-id :document-id document-id))
+ (setf *_n-map* nil)))
(defun init-rdf-module (&optional (revision (get-revision)))
@@ -108,61 +109,99 @@
(get-literals-of-node-content elem tm-id
xml-base xml-lang)))
(associations (get-associations-of-node-content elem tm-id xml-base))
- (types (append (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 fn-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))))
(super-classes
(get-super-classes-of-node-content elem tm-id xml-base)))
(with-tm (start-revision document-id tm-id)
- (let ((topic-stub
- (make-topic-stub
- about ID nodeID UUID start-revision xml-importer::tm
- :document-id document-id)))
- (map 'list #'(lambda(literal)
- (make-occurrence topic-stub literal start-revision
- tm-id :document-id document-id))
- literals)
- (map 'list #'(lambda(assoc)
- (make-association topic-stub assoc xml-importer::tm
- start-revision
- :document-id document-id))
- associations)
- (map 'list
- #'(lambda(type)
- (let ((type-topic
- (make-topic-stub (getf type :psi)
- (getf type :topicid)
- nil nil start-revision
- xml-importer::tm
- :document-id document-id))
- (ID (getf type :ID)))
- (make-instance-of-association topic-stub type-topic
- ID start-revision
- xml-importer::tm
- :document-id document-id)))
- types)
-
- ;TODO:
- ;*import standard topics from isidorus' rdf2tm namespace
- ; (must be explicitly called by the user)
- ;*get-topic by topic id
- ;*make psis
- ;*if the topic does not exist create one with topic id
- ;*add psis
- ;*make instance-of associations + reification
- ;make super-sub-class associations + reification
- ;*make occurrences + reification
- ;*make associations + reification
-
-
- ;TODO: start recursion ...
- (remove-node-properties-from-*_n-map* elem)
- (or super-classes) ;TODO: remove
- )))))
+ (elephant:ensure-transaction (:txn-nosync t)
+ (let ((topic-stub
+ (make-topic-stub
+ about ID nodeID UUID start-revision xml-importer::tm
+ :document-id document-id)))
+ (map 'list #'(lambda(literal)
+ (make-occurrence topic-stub literal start-revision
+ tm-id :document-id document-id))
+ literals)
+ (map 'list #'(lambda(assoc)
+ (make-association topic-stub assoc xml-importer::tm
+ start-revision
+ :document-id document-id))
+ associations)
+ (map 'list
+ #'(lambda(type)
+ (let ((type-topic
+ (make-topic-stub (getf type :psi)
+ nil
+ (getf type :topicid)
+ nil start-revision
+ xml-importer::tm
+ :document-id document-id))
+ (ID (getf type :ID)))
+ (make-instance-of-association topic-stub type-topic
+ ID start-revision
+ xml-importer::tm
+ :document-id document-id)))
+ types)
+ (map 'list
+ #'(lambda(class)
+ (let ((class-topic
+ (make-topic-stub (getf class :psi)
+ nil
+ (getf class :topicid)
+ nil start-revision
+ xml-importer::tm
+ :document-id document-id))
+ (ID (getf class :ID)))
+ (make-supertype-subtype-association
+ topic-stub class-topic ID start-revision
+ xml-importer::tm :document-id document-id)))
+ super-classes)
+
+ ;TODO: start recursion ...
+ (remove-node-properties-from-*_n-map* elem)))))))
+(defun make-supertype-subtype-association (sub-top super-top reifier-id
+ start-revision tm
+ &key (document-id *document-id*))
+ "Creates an supertype-subtype association."
+ (declare (TopicC sub-top super-top))
+ (declare (TopicMapC tm))
+ (let ((assoc-type (get-item-by-psi *supertype-subtype-psi*))
+ (role-type-1 (get-item-by-psi *supertype-psi*))
+ (role-type-2 (get-item-by-psi *subtype-psi*))
+ (err-pref "From make-supertype-subtype-association(): "))
+ (unless assoc-type
+ (error "~athe association type ~a is missing!"
+ err-pref *supertype-subtype-psi*))
+ (unless (or role-type-1 role-type-2)
+ (error "~aone of the role types ~a ~a is missing!"
+ err-pref *supertype-psi* *subtype-psi*))
+ (elephant:ensure-transaction (:txn-nosync t)
+ (let ((a-roles (list (list :instance-of role-type-1
+ :player super-top)
+ (list :instance-of role-type-2
+ :player sub-top))))
+ (when reifier-id
+ (make-reification reifier-id sub-top super-top
+ assoc-type start-revision tm
+ :document-id document-id))
+ (add-to-topicmap
+ tm
+ (make-construct 'AssociationC
+ :start-revision start-revision
+ :instance-of assoc-type
+ :roles a-roles))))))
+
(defun make-instance-of-association (instance-top type-top reifier-id
start-revision tm
@@ -175,21 +214,29 @@
(roletype-1
(get-item-by-psi *type-psi*))
(roletype-2
- (get-item-by-psi *instance-psi*)))
- (let ((a-roles (list (list :instance-of roletype-1
- :player type-top)
- (list :instance-of roletype-2
- :player instance-top))))
- (when reifier-id
- (make-reification reifier-id instance-top type-top
- assoc-type start-revision tm
- :document-id document-id))
- (add-to-topicmap
- tm
- (make-construct 'AssociationC
- :start-revision start-revision
- :instance-of assoc-type
- :roles a-roles)))))
+ (get-item-by-psi *instance-psi*))
+ (err-pref "From make-instance-of-association(): "))
+ (unless assoc-type
+ (error "~athe association type ~a is missing!"
+ err-pref *type-instance-psi*))
+ (unless (or roletype-1 roletype-2)
+ (error "~aone of the role types ~a ~a is missing!"
+ err-pref *type-psi* *instance-psi*))
+ (elephant:ensure-transaction (:txn-nosync t)
+ (let ((a-roles (list (list :instance-of roletype-1
+ :player type-top)
+ (list :instance-of roletype-2
+ :player instance-top))))
+ (when reifier-id
+ (make-reification reifier-id instance-top type-top
+ assoc-type start-revision tm
+ :document-id document-id))
+ (add-to-topicmap
+ tm
+ (make-construct 'AssociationC
+ :start-revision start-revision
+ :instance-of assoc-type
+ :roles a-roles))))))
(defun make-topic-stub (about ID nodeId UUID start-revision
@@ -200,8 +247,18 @@
(declare (TopicMapC tm))
(let ((topic-id (or about ID nodeID UUID))
(psi-uri (or about ID)))
- (let ((top (get-item-by-id topic-id :xtm-id document-id
- :revision start-revision)))
+ (let ((top
+ ;seems like there is a bug in get-item-by-id:
+ ;this functions returns an emtpy topic although there is no one
+ ;witha corresponding topic id and/or version and/or xtm-id
+ (let ((inner-top
+ (get-item-by-id topic-id :xtm-id document-id
+ :revision start-revision)))
+ (when (and inner-top
+ (find-if #'(lambda(x)
+ (= (d::start-revision x) start-revision))
+ (d::versions inner-top)))
+ inner-top))))
(if top
top
(elephant:ensure-transaction (:txn-nosync t)
@@ -245,24 +302,26 @@
(player-id (getf association :topicid))
(player-psi (getf association :psi))
(ID (getf association :ID)))
- (let ((player-1 (make-topic-stub player-psi player-id nil nil start-revision
- tm :document-id document-id))
- (role-type-1 (get-item-by-psi *rdf2tm-object*))
- (role-type-2 (get-item-by-psi *rdf2tm-subject*))
- (type-top (make-topic-stub type nil nil nil start-revision
- tm :document-id document-id)))
- (let ((roles (list (list :instance-of role-type-1
- :player player-1)
- (list :instance-of role-type-2
- :player top))))
- (when ID
- (make-reification ID top type-top player-1 start-revision
- tm :document-id document-id))
- (add-to-topicmap tm (make-construct 'AssociationC
- :start-revision start-revision
- :instance-of type-top
- :roles roles))))))
-
+ (elephant:ensure-transaction (:txn-nosync t)
+ (let ((player-1 (make-topic-stub player-psi nil player-id nil
+ start-revision
+ tm :document-id document-id))
+ (role-type-1 (get-item-by-psi *rdf2tm-object*))
+ (role-type-2 (get-item-by-psi *rdf2tm-subject*))
+ (type-top (make-topic-stub type nil nil nil start-revision
+ tm :document-id document-id)))
+ (let ((roles (list (list :instance-of role-type-1
+ :player player-1)
+ (list :instance-of role-type-2
+ :player top))))
+ (when ID
+ (make-reification ID top type-top player-1 start-revision
+ tm :document-id document-id))
+ (add-to-topicmap tm (make-construct 'AssociationC
+ :start-revision start-revision
+ :instance-of type-top
+ :roles roles)))))))
+
(defun make-association-with-nodes (subject-topic object-topic
associationtype-topic tm start-revision)
@@ -275,10 +334,11 @@
:player subject-topic)
(list :instance-of role-type-2
:player object-topic))))
- (add-to-topicmap tm (make-construct 'AssociationC
- :start-revision start-revision
- :instance-of associationtype-topic
- :roles roles)))))
+ (elephant:ensure-transaction (:txn-nosync t)
+ (add-to-topicmap tm (make-construct 'AssociationC
+ :start-revision start-revision
+ :instance-of associationtype-topic
+ :roles roles))))))
(defun make-reification (reifier-id subject object predicate start-revision tm
@@ -294,25 +354,27 @@
tm :document-id document-id))
(object-arc (make-topic-stub *rdf-object* nil nil nil start-revision
tm :document-id document-id))
- (subject-arc (make-topic-stub *rdf-object* nil nil nil start-revision
+ (subject-arc (make-topic-stub *rdf-subject* nil nil nil start-revision
tm :document-id document-id))
(statement (make-topic-stub *rdf-statement* nil nil nil start-revision
tm :document-id document-id)))
- (make-instance-of-association reifier statement nil start-revision tm
- :document-id document-id)
- (make-association-with-nodes reifier subject subject-arc tm start-revision)
- (make-association-with-nodes reifier predicate-arc predicate
- tm start-revision)
- (if (typep object 'TopicC)
- (make-association-with-nodes reifier object object-arc
- tm start-revision)
- (make-construct 'OccurrenceC
- :start-revision start-revision
- :topic reifier
- :themes (themes object)
- :instance-of (instance-of object)
- :charvalue (charvalue object)
- :datatype (datatype object)))))
+ (elephant:ensure-transaction (:txn-nosync t)
+ (make-instance-of-association reifier statement nil start-revision tm
+ :document-id document-id)
+ (make-association-with-nodes reifier subject subject-arc tm
+ start-revision)
+ (make-association-with-nodes reifier predicate predicate-arc
+ tm start-revision)
+ (if (typep object 'TopicC)
+ (make-association-with-nodes reifier object object-arc
+ tm start-revision)
+ (make-construct 'OccurrenceC
+ :start-revision start-revision
+ :topic reifier
+ :themes (themes object)
+ :instance-of (instance-of object)
+ :charvalue (charvalue object)
+ :datatype (datatype object))))))
(defun make-occurrence (top literal start-revision tm-id
@@ -327,25 +389,26 @@
(lang (getf literal :lang))
(datatype (getf literal :datatype))
(ID (getf literal :ID)))
- (let ((type-top (make-topic-stub type nil nil nil start-revision
- xml-importer::tm
- :document-id document-id))
- (lang-top (make-lang-topic lang tm-id start-revision
- xml-importer::tm
- :document-id document-id)))
- (let ((occurrence
- (make-construct 'OccurrenceC
- :start-revision start-revision
- :topic top
- :themes (when lang-top
- (list lang-top))
- :instance-of type-top
- :charvalue value
- :datatype datatype)))
- (when ID
- (make-reification ID top type-top occurrence start-revision
- xml-importer::tm :document-id document-id))
- occurrence)))))
+ (elephant:ensure-transaction (:txn-nosync t)
+ (let ((type-top (make-topic-stub type nil nil nil start-revision
+ xml-importer::tm
+ :document-id document-id))
+ (lang-top (make-lang-topic lang tm-id start-revision
+ xml-importer::tm
+ :document-id document-id)))
+ (let ((occurrence
+ (make-construct 'OccurrenceC
+ :start-revision start-revision
+ :topic top
+ :themes (when lang-top
+ (list lang-top))
+ :instance-of type-top
+ :charvalue value
+ :datatype datatype)))
+ (when ID
+ (make-reification ID top type-top occurrence start-revision
+ xml-importer::tm :document-id document-id))
+ occurrence))))))
(defun get-literals-of-node-content (node tm-id xml-base xml-lang)
Modified: trunk/src/xml/rdf/rdf_core_psis.xtm
==============================================================================
--- trunk/src/xml/rdf/rdf_core_psis.xtm (original)
+++ trunk/src/xml/rdf/rdf_core_psis.xtm Mon Aug 3 13:08:11 2009
@@ -17,11 +17,32 @@
</name>
</topic>
- <topic id="object">
+ <topic id="object">
<subjectIdentifier href="http://isidorus/rdf2tm_mapping#object"/>
<name>
<value>object</value>
</name>
</topic>
+ <topic id="supertype-subtype">
+ <subjectIdentifier href="http://psi.topicmaps.org/iso13250/model/supertype-subtype"/>
+ <name>
+ <value>supertype-subtype</value>
+ </name>
+ </topic>
+
+ <topic id="superclass">
+ <subjectIdentifier href="http://psi.topicmaps.org/iso13250/model/supertype"/>
+ <name>
+ <value>supertype</value>
+ </name>
+ </topic>
+
+ <topic id="subtype">
+ <subjectIdentifier href="http://psi.topicmaps.org/iso13250/model/subtype"/>
+ <name>
+ <value>subtype</value>
+ </name>
+ </topic>
+
</topicMap>
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 3 13:08:11 2009
@@ -24,7 +24,10 @@
*rdf-subject*
*rdf-predicate*
*rdf2tm-object*
- *rdf2tm-subject*)
+ *rdf2tm-subject*
+ *supertype-psi*
+ *subtype-psi*
+ *supertype-subtype-psi*)
(:import-from :xml-constants
*rdf_core_psis.xtm*)
(:import-from :xml-constants
@@ -59,7 +62,11 @@
with-writer-lock)
(:import-from :exceptions
missing-reference-error
- duplicate-identifier-error))
+ duplicate-identifier-error)
+ (:export :setup-rdf-module
+ :rdf-importer
+ :init-rdf-module
+ :*rdf-core-xtm*))
(in-package :rdf-importer)
Modified: trunk/src/xml/xtm/tools.lisp
==============================================================================
--- trunk/src/xml/xtm/tools.lisp (original)
+++ trunk/src/xml/xtm/tools.lisp Mon Aug 3 13:08:11 2009
@@ -71,6 +71,8 @@
"Returns the passed id as an absolute uri computed
with the given base and tm-id."
(declare (string id tm-id))
+ (when (= (length id) 0)
+ (error "From absolutize-id(): id must be set to a string with length > 0!"))
(let ((prep-id (if (and (> (length id) 0)
(eql (elt id 0) #\#))
id
@@ -109,7 +111,11 @@
(prep-tm-id
(when (> (length tm-id) 0)
(string-right-trim "/" tm-id))))
- (concatenate 'string prep-tm-id "/" prep-fragment)))))))
+ (let ((separator
+ (if (eql (elt prep-fragment 0) #\#)
+ ""
+ "/")))
+ (concatenate 'string prep-tm-id separator prep-fragment))))))))
(defun get-xml-lang(elem &key (old-lang nil))
1
0