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