isidorus-cvs

isidorus-cvs@common-lisp.net

1037 discussions

[isidorus-cvs] r114 - in trunk/src: unit_tests xml/xtm
by Lukas Giessmann 13 Aug '09

13 Aug '09

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

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

13 Aug '09

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

[isidorus-cvs] r112 - in trunk/src: unit_tests xml/rdf
by Lukas Giessmann 10 Aug '09

10 Aug '09

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

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

07 Aug '09

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

[isidorus-cvs] r110 - trunk/src/unit_tests
by Lukas Giessmann 06 Aug '09

06 Aug '09

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

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

06 Aug '09

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">  <arcs:start rdf:datatype="#date">01.01.1797</arcs:start> @@ -194,10 +195,10 @@  <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/"> +  + <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> + +  + <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> + +  + <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> + +  + <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">  + <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> + +  + <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

[isidorus-cvs] r108 - in trunk/src: unit_tests xml/rdf
by Lukas Giessmann 05 Aug '09

05 Aug '09

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

[isidorus-cvs] r107 - in trunk/src: unit_tests xml/rdf
by Lukas Giessmann 05 Aug '09

05 Aug '09

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

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

05 Aug '09

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

[isidorus-cvs] r105 - trunk/src/unit_tests
by Lukas Giessmann 04 Aug '09

04 Aug '09

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

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

isidorus-cvs