Changeset 103

Timestamp:

08/03/09 17:08:11 (16 years ago)

Author:

lgiessmann

Message:

added some unit tests for the rdf-importer and fixed several bugs

Location:

trunk/src

Files:

• unit_tests/rdf_importer_test.lisp (modified) (5 diffs)
• xml/rdf/importer.lisp (modified) (9 diffs)
• xml/rdf/rdf_core_psis.xtm (modified) (2 diffs)
• xml/rdf/rdf_tools.lisp (modified) (2 diffs)
• xml/xtm/tools.lisp (modified) (2 diffs)

trunk/src/unit_tests/rdf_importer_test.lisp ¶

@@ -20 +20 @@
                 *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
@@ -37 +49 @@
            :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)))
@@ -48 +62 @@
 
 (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))
 
 
@@ -968 +992 @@
         (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
+
+  )
+
 
 
@@ -980 +1218 @@
   (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))
+  (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))

trunk/src/xml/rdf/importer.lisp ¶

@@ -9 +9 @@
 
 
-(defvar *document-id* nil)
+(defvar *document-id* "isidorus-rdf-document")
 
 
@@ -38 +38 @@
   (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)))
 
 
@@ -109 +110 @@
                                                           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))))))
 
 
@@ -176 +215 @@
          (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))))))
 
 
@@ -201 +248 @@
   (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
@@ -246 +303 @@
         (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
@@ -276 +335 @@
                        (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))))))
 
 
@@ -295 +355 @@
         (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))))))
 
 
@@ -328 +390 @@
           (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))))))
             
 

trunk/src/xml/rdf/rdf_core_psis.xtm ¶

@@ -18 +18 @@
   </topic>
 
-    <topic id="object">
+  <topic id="object">
     <subjectIdentifier href="http://isidorus/rdf2tm_mapping#object"/>
     <name>
@@ -25 +25 @@
   </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>

trunk/src/xml/rdf/rdf_tools.lisp ¶

@@ -25 +25 @@
                 *rdf-predicate*
                 *rdf2tm-object*
-                *rdf2tm-subject*)
+                *rdf2tm-subject*
+                *supertype-psi*
+                *subtype-psi*
+                *supertype-subtype-psi*)
   (:import-from :xml-constants
                 *rdf_core_psis.xtm*)
@@ -60 +63 @@
   (: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)

trunk/src/xml/xtm/tools.lisp ¶

@@ -72 +72 @@
    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) #\#))
@@ -110 +112 @@
                      (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))))))))