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!"