[isidorus-cvs] r103 - in trunk/src: unit_tests xml/rdf xml/xtm
Lukas Giessmann
lgiessmann at common-lisp.net
Mon Aug 3 17:08:12 UTC 2009
Author: lgiessmann
Date: Mon Aug 3 13:08:11 2009
New Revision: 103
Log:
added some unit tests for the rdf-importer and fixed several bugs
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
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 Mon Aug 3 13:08:11 2009
@@ -19,7 +19,19 @@
*rdfs-ns*
*rdf2tm-ns*
*xml-ns*
- *xml-string*)
+ *xml-string*
+ *instance-psi*
+ *type-psi*
+ *type-instance-psi*
+ *subtype-psi*
+ *supertype-psi*
+ *supertype-subtype-psi*
+ *xml-string*
+ *rdf2tm-object*
+ *rdf2tm-subject*
+ *rdf-subject*
+ *rdf-object*
+ *rdf-predicate*)
(:import-from :xml-tools
xpath-child-elems-by-qname
xpath-single-child-elem-by-qname
@@ -36,7 +48,9 @@
:test-get-literals-of-content
:test-get-super-classes-of-node-content
:test-get-associations-of-node-content
- :test-parse-properties-of-node))
+ :test-parse-properties-of-node
+ :test-import-node-1
+ :test-import-node-reification))
(declaim (optimize (debug 3) (speed 0) (safety 3) (space 0) (compilation-speed 0)))
@@ -49,6 +63,16 @@
(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
@@ -967,7 +991,221 @@
(rdf-importer::remove-node-properties-from-*_n-map* node)
(is (= (length rdf-importer::*_n-map*) 0))))))
+
+(test test-import-node-1
+ "Tests the function import-node non-recursively."
+ (let ((db-dir "data_base")
+ (tm-id "http://test-tm/")
+ (revision-1 100)
+ (revision-2 200)
+ (revision-3 300)
+ (document-id "doc-id")
+ (doc-1
+ (concatenate 'string "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" "
+ "xmlns:arcs=\"http://test/arcs/\" "
+ "xmlns:rdfs=\"" *rdfs-ns* "\">"
+ "<rdf:Description rdf:about=\"first-node\">"
+ "<rdf:type rdf:resource=\"first-type\" />"
+ "</rdf:Description>"
+ "<rdf:Description rdf:type=\"second-type\" "
+ "rdf:nodeID=\"second-node\">"
+ "<rdfs:subClassOf>"
+ "<rdf:Description rdf:ID=\"third-node\" />"
+ "</rdfs:subClassOf>"
+ "</rdf:Description>"
+ "<rdf:Description arcs:arc1=\"arc-1\">"
+ "<arcs:arc2 rdf:datatype=\"dt\">arc-2</arcs:arc2>"
+ "</rdf:Description>"
+ "<rdf:Description rdf:about=\"fourth-node\">"
+ "<arcs:arc3 rdf:parseType=\"Literal\"><root>"
+ "<content type=\"anyContent\">content</content>"
+ "</root></arcs:arc3>"
+ "</rdf:Description>"
+ "<rdf:Description rdf:ID=\"fifth-node\">"
+ "<arcs:arc4 rdf:parseType=\"Resource\">"
+ "<arcs:arc5 rdf:resource=\"arc-5\" />"
+ "</arcs:arc4>"
+ "</rdf:Description>"
+ "</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))
+ (let ((rdf-node (elt (dom:child-nodes dom-1) 0)))
+ (is (= (length (dom:child-nodes rdf-node)) 5))
+ (let ((node (elt (dom:child-nodes rdf-node) 0)))
+ (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))
+ (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"
+ :xtm-id document-id)))
+ (is-true first-node)
+ (is (= (length (d::versions first-node)) 1))
+ (is (= (d::start-revision (first (d::versions first-node)))
+ revision-2))
+ (is (= (d::end-revision (first (d::versions first-node))) 0))
+ (is-true first-type)
+ (is (= (length (d:player-in-roles first-node)) 1))
+ (is (= (length (d:player-in-roles first-type)) 1))
+ (let ((instance-role
+ (first (d:player-in-roles first-node)))
+ (type-role
+ (first (d:player-in-roles first-type)))
+ (type-assoc
+ (d:parent (first (d:player-in-roles first-node)))))
+ (is (= (length (d::versions type-assoc)) 1))
+ (is (= (d::start-revision (first (d::versions type-assoc)))
+ revision-2))
+ (is (eql (d:instance-of instance-role)
+ (d:get-item-by-psi *instance-psi*)))
+ (is (eql (d:instance-of type-role)
+ (d:get-item-by-psi *type-psi*)))
+ (is (eql (d:instance-of type-assoc)
+ (d:get-item-by-psi *type-instance-psi*)))
+ (is (= (length (d:roles type-assoc)) 2))
+ (is (= (length (d:psis first-node)) 1))
+ (is (= (length (d:psis first-type)) 1))
+ (is (string= (d:uri (first (d:psis first-node)))
+ "http://test-tm/first-node"))
+ (is (string= (d:uri (first (d:psis first-type)))
+ "http://test-tm/first-type"))
+ (is (= (length (elephant:get-instances-by-class 'd:OccurrenceC))))
+ (is (= (length (elephant:get-instances-by-class 'd:NameC))))
+ (is (= (length (elephant:get-instances-by-class 'd:VariantC)))))
+ (dotimes (iter (length (dom:child-nodes rdf-node)))
+ (rdf-importer::import-node (elt (dom:child-nodes rdf-node) iter)
+ tm-id revision-3
+ :document-id document-id))
+ (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"
+ :xtm-id document-id))
+ (second-node (get-item-by-id "second-node"
+ :xtm-id document-id))
+ (second-type (get-item-by-id "http://test-tm/second-type"
+ :xtm-id document-id))
+ (third-node (get-item-by-id "http://test-tm#third-node"
+ :xtm-id document-id)))
+ (is-true second-node)
+ (is-false (d:psis second-node))
+ (is-false (d:occurrences second-node))
+ (is-false (d:names second-node))
+ (is-true first-node)
+ (is (= (length (d::versions first-node)) 2))
+ (is-true (find-if #'(lambda(x)
+ (and (= (d::start-revision x) revision-2)
+ (= (d::end-revision x) revision-3)))
+ (d::versions first-node)))
+ (is-true (find-if #'(lambda(x)
+ (and (= (d::start-revision x) revision-3)
+ (= (d::end-revision x) 0)))
+ (d::versions first-node)))
+ (let ((instance-role
+ (first (d:player-in-roles first-node)))
+ (type-role
+ (first (d:player-in-roles first-type)))
+ (type-assoc
+ (d:parent (first (d:player-in-roles first-node))))
+ (type-topic (get-item-by-psi *type-psi*))
+ (instance-topic (get-item-by-psi *instance-psi*))
+ (type-instance-topic (get-item-by-psi *type-instance-psi*))
+ (supertype-topic (get-item-by-psi *supertype-psi*))
+ (subtype-topic (get-item-by-psi *subtype-psi*))
+ (supertype-subtype-topic
+ (get-item-by-psi *supertype-subtype-psi*))
+ (arc2-occurrence (elephant:get-instance-by-value
+ 'd:OccurrenceC 'd:charvalue "arc-2"))
+ (arc3-occurrence
+ (elephant:get-instance-by-value
+ 'd:OccurrenceC 'd:charvalue
+ "<root><content type=\"anyContent\">content</content></root>"))
+ (fifth-node (d:get-item-by-id "http://test-tm#fifth-node"
+ :xtm-id document-id)))
+ (is (eql (d:instance-of instance-role)
+ (d:get-item-by-psi *instance-psi*)))
+ (is (eql (d:instance-of type-role)
+ (d:get-item-by-psi *type-psi*)))
+ (is (eql (d:instance-of type-assoc)
+ (d:get-item-by-psi *type-instance-psi*)))
+ (is (= (length (d:roles type-assoc)) 2))
+ (is (= (length (d:psis first-node)) 1))
+ (is (= (length (d:psis first-type)) 1))
+ (is (= (length (d::versions type-assoc)) 1))
+ (is (= (length (d:player-in-roles second-node)) 2))
+ (is-true (find-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) instance-topic)
+ (eql (d:instance-of (d:parent x) )
+ type-instance-topic)))
+ (d:player-in-roles second-node)))
+ (is-true (find-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) subtype-topic)
+ (eql (d:instance-of (d:parent x) )
+ supertype-subtype-topic)))
+ (d:player-in-roles second-node)))
+ (is-true (find-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) type-topic)
+ (eql (d:instance-of (d:parent x) )
+ type-instance-topic)))
+ (d:player-in-roles second-type)))
+ (is-true (find-if
+ #'(lambda(x)
+ (and (eql (d:instance-of x) supertype-topic)
+ (eql (d:instance-of (d:parent x) )
+ supertype-subtype-topic)))
+ (d:player-in-roles third-node)))
+ (is-true arc2-occurrence)
+ (is (string= (d:datatype arc2-occurrence) "http://test-tm/dt"))
+ (is-false (d:psis (d:topic arc2-occurrence)))
+ (is (= (length (d::versions (d:topic arc2-occurrence))) 1))
+ (is (= (d::start-revision
+ (first (d::versions (d:topic arc2-occurrence))))
+ revision-3))
+ (is (= (d::end-revision
+ (first (d::versions (d:topic arc2-occurrence)))) 0))
+ (is-true arc3-occurrence)
+ (is (= (length (d:psis (d:topic arc3-occurrence)))))
+ (is (string= (d:uri (first (d:psis (d:topic arc3-occurrence))))
+ "http://test-tm/fourth-node"))
+ (is (string= (d:datatype arc3-occurrence)
+ *xml-string*))
+ (is-true fifth-node)
+ (is (= (length (d:psis fifth-node)) 1))
+ (is (string= (d:uri (first (d:psis fifth-node)))
+ "http://test-tm#fifth-node"))
+ (is-false (d:occurrences fifth-node))
+ (is-false (d:names fifth-node))
+ (is (= (length (d:player-in-roles fifth-node))))
+ (let ((assoc (d:parent (first (d:player-in-roles
+ fifth-node)))))
+ (is-true assoc)
+ (let ((object-role
+ (find-if
+ #'(lambda(role)
+ (eql (d:instance-of role)
+ (d:get-item-by-psi *rdf2tm-object*)))
+ (d:roles assoc)))
+ (subject-role
+ (find-if
+ #'(lambda(role)
+ (eql (d:instance-of role)
+ (d:get-item-by-psi *rdf2tm-subject*)))
+ (d:roles assoc))))
+ (is-true object-role)
+ (is-true subject-role)
+ (is (eql (d:player subject-role) fifth-node))
+ (is-false (d:psis (d:player object-role))))))))))))
+ (elephant:close-store))
+
+(test test-import-node-reification
+
+ )
+
(defun run-rdf-importer-tests()
@@ -979,4 +1217,6 @@
(it.bese.fiveam:run! 'test-get-literals-of-content)
(it.bese.fiveam:run! 'test-get-super-classes-of-node-content)
(it.bese.fiveam:run! 'test-get-associations-of-node-content)
- (it.bese.fiveam:run! 'test-parse-properties-of-node))
\ No newline at end of file
+ (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
Modified: trunk/src/xml/rdf/importer.lisp
==============================================================================
--- trunk/src/xml/rdf/importer.lisp (original)
+++ trunk/src/xml/rdf/importer.lisp Mon Aug 3 13:08:11 2009
@@ -8,7 +8,7 @@
(in-package :rdf-importer)
-(defvar *document-id* nil)
+(defvar *document-id* "isidorus-rdf-document")
(defun setup-rdf-module (rdf-xml-path repository-path
@@ -37,15 +37,16 @@
"Imports the file correponding to the given path."
(setf *document-id* document-id)
(tm-id-p tm-id "rdf-importer")
- (unless elephant:*store-controller*
- (elephant:open-store
- (get-store-spec repository-path)))
- (let ((rdf-dom
- (dom:document-element (cxml:parse-file
- (truename rdf-xml-path)
- (cxml-dom:make-dom-builder)))))
- (import-dom rdf-dom start-revision :tm-id tm-id :document-id document-id))
- (setf *_n-map* nil))
+ (with-writer-lock
+ (unless elephant:*store-controller*
+ (elephant:open-store
+ (get-store-spec repository-path)))
+ (let ((rdf-dom
+ (dom:document-element (cxml:parse-file
+ (truename rdf-xml-path)
+ (cxml-dom:make-dom-builder)))))
+ (import-dom rdf-dom start-revision :tm-id tm-id :document-id document-id))
+ (setf *_n-map* nil)))
(defun init-rdf-module (&optional (revision (get-revision)))
@@ -108,61 +109,99 @@
(get-literals-of-node-content elem tm-id
xml-base xml-lang)))
(associations (get-associations-of-node-content elem tm-id xml-base))
- (types (append (list
- (list :topicid (get-type-of-node-name elem)
- :psi (get-type-of-node-name elem)
- :ID nil))
- (get-types-of-node-content elem tm-id fn-xml-base)))
+ (types (remove-if
+ #'null
+ (append (list
+ (unless (string= (get-type-of-node-name elem)
+ (concatenate 'string *rdf-ns*
+ "Description"))
+ (list :topicid (get-type-of-node-name elem)
+ :psi (get-type-of-node-name elem)
+ :ID nil)))
+ (get-types-of-node-content elem tm-id fn-xml-base))))
(super-classes
(get-super-classes-of-node-content elem tm-id xml-base)))
(with-tm (start-revision document-id tm-id)
- (let ((topic-stub
- (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)
- (getf type :topicid)
- nil 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)
-
- ;TODO:
- ;*import standard topics from isidorus' rdf2tm namespace
- ; (must be explicitly called by the user)
- ;*get-topic by topic id
- ;*make psis
- ;*if the topic does not exist create one with topic id
- ;*add psis
- ;*make instance-of associations + reification
- ;make super-sub-class associations + reification
- ;*make occurrences + reification
- ;*make associations + reification
-
-
- ;TODO: start recursion ...
- (remove-node-properties-from-*_n-map* elem)
- (or super-classes) ;TODO: remove
- )))))
+ (elephant:ensure-transaction (:txn-nosync t)
+ (let ((topic-stub
+ (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)))))))
+(defun make-supertype-subtype-association (sub-top super-top reifier-id
+ start-revision tm
+ &key (document-id *document-id*))
+ "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*))
+ (err-pref "From make-supertype-subtype-association(): "))
+ (unless assoc-type
+ (error "~athe association type ~a is missing!"
+ err-pref *supertype-subtype-psi*))
+ (unless (or role-type-1 role-type-2)
+ (error "~aone of the role types ~a ~a is missing!"
+ err-pref *supertype-psi* *subtype-psi*))
+ (elephant:ensure-transaction (:txn-nosync t)
+ (let ((a-roles (list (list :instance-of role-type-1
+ :player super-top)
+ (list :instance-of role-type-2
+ :player sub-top))))
+ (when reifier-id
+ (make-reification reifier-id sub-top super-top
+ assoc-type start-revision tm
+ :document-id document-id))
+ (add-to-topicmap
+ tm
+ (make-construct 'AssociationC
+ :start-revision start-revision
+ :instance-of assoc-type
+ :roles a-roles))))))
+
(defun make-instance-of-association (instance-top type-top reifier-id
start-revision tm
@@ -175,21 +214,29 @@
(roletype-1
(get-item-by-psi *type-psi*))
(roletype-2
- (get-item-by-psi *instance-psi*)))
- (let ((a-roles (list (list :instance-of roletype-1
- :player type-top)
- (list :instance-of roletype-2
- :player instance-top))))
- (when reifier-id
- (make-reification reifier-id instance-top type-top
- assoc-type start-revision tm
- :document-id document-id))
- (add-to-topicmap
- tm
- (make-construct 'AssociationC
- :start-revision start-revision
- :instance-of assoc-type
- :roles a-roles)))))
+ (get-item-by-psi *instance-psi*))
+ (err-pref "From make-instance-of-association(): "))
+ (unless assoc-type
+ (error "~athe association type ~a is missing!"
+ err-pref *type-instance-psi*))
+ (unless (or roletype-1 roletype-2)
+ (error "~aone of the role types ~a ~a is missing!"
+ err-pref *type-psi* *instance-psi*))
+ (elephant:ensure-transaction (:txn-nosync t)
+ (let ((a-roles (list (list :instance-of roletype-1
+ :player type-top)
+ (list :instance-of roletype-2
+ :player instance-top))))
+ (when reifier-id
+ (make-reification reifier-id instance-top type-top
+ assoc-type start-revision tm
+ :document-id document-id))
+ (add-to-topicmap
+ tm
+ (make-construct 'AssociationC
+ :start-revision start-revision
+ :instance-of assoc-type
+ :roles a-roles))))))
(defun make-topic-stub (about ID nodeId UUID start-revision
@@ -200,8 +247,18 @@
(declare (TopicMapC tm))
(let ((topic-id (or about ID nodeID UUID))
(psi-uri (or about ID)))
- (let ((top (get-item-by-id topic-id :xtm-id document-id
- :revision start-revision)))
+ (let ((top
+ ;seems like there is a bug in get-item-by-id:
+ ;this functions returns an emtpy topic although there is no one
+ ;witha corresponding topic id and/or version and/or xtm-id
+ (let ((inner-top
+ (get-item-by-id topic-id :xtm-id document-id
+ :revision start-revision)))
+ (when (and inner-top
+ (find-if #'(lambda(x)
+ (= (d::start-revision x) start-revision))
+ (d::versions inner-top)))
+ inner-top))))
(if top
top
(elephant:ensure-transaction (:txn-nosync t)
@@ -245,24 +302,26 @@
(player-id (getf association :topicid))
(player-psi (getf association :psi))
(ID (getf association :ID)))
- (let ((player-1 (make-topic-stub player-psi player-id nil 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*))
- (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
- :player player-1)
- (list :instance-of role-type-2
- :player top))))
- (when ID
- (make-reification ID top type-top player-1 start-revision
- tm :document-id document-id))
- (add-to-topicmap tm (make-construct 'AssociationC
- :start-revision start-revision
- :instance-of type-top
- :roles roles))))))
-
+ (elephant:ensure-transaction (:txn-nosync t)
+ (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*))
+ (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
+ :player player-1)
+ (list :instance-of role-type-2
+ :player top))))
+ (when ID
+ (make-reification ID top type-top player-1 start-revision
+ tm :document-id document-id))
+ (add-to-topicmap tm (make-construct 'AssociationC
+ :start-revision start-revision
+ :instance-of type-top
+ :roles roles)))))))
+
(defun make-association-with-nodes (subject-topic object-topic
associationtype-topic tm start-revision)
@@ -275,10 +334,11 @@
:player subject-topic)
(list :instance-of role-type-2
:player object-topic))))
- (add-to-topicmap tm (make-construct 'AssociationC
- :start-revision start-revision
- :instance-of associationtype-topic
- :roles roles)))))
+ (elephant:ensure-transaction (:txn-nosync t)
+ (add-to-topicmap tm (make-construct 'AssociationC
+ :start-revision start-revision
+ :instance-of associationtype-topic
+ :roles roles))))))
(defun make-reification (reifier-id subject object predicate start-revision tm
@@ -294,25 +354,27 @@
tm :document-id document-id))
(object-arc (make-topic-stub *rdf-object* nil nil nil start-revision
tm :document-id document-id))
- (subject-arc (make-topic-stub *rdf-object* nil nil nil start-revision
+ (subject-arc (make-topic-stub *rdf-subject* nil nil nil start-revision
tm :document-id document-id))
(statement (make-topic-stub *rdf-statement* nil nil nil start-revision
tm :document-id document-id)))
- (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)
- (make-association-with-nodes reifier predicate-arc predicate
- tm start-revision)
- (if (typep object 'TopicC)
- (make-association-with-nodes reifier object object-arc
- tm start-revision)
- (make-construct 'OccurrenceC
- :start-revision start-revision
- :topic reifier
- :themes (themes object)
- :instance-of (instance-of object)
- :charvalue (charvalue object)
- :datatype (datatype object)))))
+ (elephant:ensure-transaction (:txn-nosync t)
+ (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)
+ (make-association-with-nodes reifier predicate predicate-arc
+ tm start-revision)
+ (if (typep object 'TopicC)
+ (make-association-with-nodes reifier object object-arc
+ tm start-revision)
+ (make-construct 'OccurrenceC
+ :start-revision start-revision
+ :topic reifier
+ :themes (themes object)
+ :instance-of (instance-of object)
+ :charvalue (charvalue object)
+ :datatype (datatype object))))))
(defun make-occurrence (top literal start-revision tm-id
@@ -327,25 +389,26 @@
(lang (getf literal :lang))
(datatype (getf literal :datatype))
(ID (getf literal :ID)))
- (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
- xml-importer::tm
- :document-id document-id)))
- (let ((occurrence
- (make-construct 'OccurrenceC
- :start-revision start-revision
- :topic top
- :themes (when lang-top
- (list lang-top))
- :instance-of type-top
- :charvalue value
- :datatype datatype)))
- (when ID
- (make-reification ID top type-top occurrence start-revision
- xml-importer::tm :document-id document-id))
- occurrence)))))
+ (elephant:ensure-transaction (:txn-nosync t)
+ (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
+ xml-importer::tm
+ :document-id document-id)))
+ (let ((occurrence
+ (make-construct 'OccurrenceC
+ :start-revision start-revision
+ :topic top
+ :themes (when lang-top
+ (list lang-top))
+ :instance-of type-top
+ :charvalue value
+ :datatype datatype)))
+ (when ID
+ (make-reification ID top type-top occurrence start-revision
+ xml-importer::tm :document-id document-id))
+ occurrence))))))
(defun get-literals-of-node-content (node tm-id xml-base xml-lang)
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 Mon Aug 3 13:08:11 2009
@@ -17,11 +17,32 @@
</name>
</topic>
- <topic id="object">
+ <topic id="object">
<subjectIdentifier href="http://isidorus/rdf2tm_mapping#object"/>
<name>
<value>object</value>
</name>
</topic>
+ <topic id="supertype-subtype">
+ <subjectIdentifier href="http://psi.topicmaps.org/iso13250/model/supertype-subtype"/>
+ <name>
+ <value>supertype-subtype</value>
+ </name>
+ </topic>
+
+ <topic id="superclass">
+ <subjectIdentifier href="http://psi.topicmaps.org/iso13250/model/supertype"/>
+ <name>
+ <value>supertype</value>
+ </name>
+ </topic>
+
+ <topic id="subtype">
+ <subjectIdentifier href="http://psi.topicmaps.org/iso13250/model/subtype"/>
+ <name>
+ <value>subtype</value>
+ </name>
+ </topic>
+
</topicMap>
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 3 13:08:11 2009
@@ -24,7 +24,10 @@
*rdf-subject*
*rdf-predicate*
*rdf2tm-object*
- *rdf2tm-subject*)
+ *rdf2tm-subject*
+ *supertype-psi*
+ *subtype-psi*
+ *supertype-subtype-psi*)
(:import-from :xml-constants
*rdf_core_psis.xtm*)
(:import-from :xml-constants
@@ -59,7 +62,11 @@
with-writer-lock)
(:import-from :exceptions
missing-reference-error
- duplicate-identifier-error))
+ duplicate-identifier-error)
+ (:export :setup-rdf-module
+ :rdf-importer
+ :init-rdf-module
+ :*rdf-core-xtm*))
(in-package :rdf-importer)
Modified: trunk/src/xml/xtm/tools.lisp
==============================================================================
--- trunk/src/xml/xtm/tools.lisp (original)
+++ trunk/src/xml/xtm/tools.lisp Mon Aug 3 13:08:11 2009
@@ -71,6 +71,8 @@
"Returns the passed id as an absolute uri computed
with the given base and tm-id."
(declare (string id tm-id))
+ (when (= (length id) 0)
+ (error "From absolutize-id(): id must be set to a string with length > 0!"))
(let ((prep-id (if (and (> (length id) 0)
(eql (elt id 0) #\#))
id
@@ -109,7 +111,11 @@
(prep-tm-id
(when (> (length tm-id) 0)
(string-right-trim "/" tm-id))))
- (concatenate 'string prep-tm-id "/" prep-fragment)))))))
+ (let ((separator
+ (if (eql (elt prep-fragment 0) #\#)
+ ""
+ "/")))
+ (concatenate 'string prep-tm-id separator prep-fragment))))))))
(defun get-xml-lang(elem &key (old-lang nil))
More information about the Isidorus-cvs
mailing list