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*)