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