[isidorus-cvs] r107 - in trunk/src: unit_tests xml/rdf
Lukas Giessmann
lgiessmann at common-lisp.net
Wed Aug 5 11:58:19 UTC 2009
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!"
More information about the Isidorus-cvs
mailing list