Changeset 156 for trunk/src/xml

Timestamp:

12/01/09 12:50:56 (15 years ago)

Author:

lgiessmann

Message:

added a mapping-schema for reification (tm->rdf; rdf->tm) to the rdf-module; unit-tests are currently missing

Location:

trunk/src/xml/rdf

Files:

• exporter.lisp (modified) (5 diffs)
• map_to_tm.lisp (modified) (13 diffs)
• rdf_tools.lisp (modified) (1 diff)

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

@@ -27 +27 @@
                 *tm2rdf-topic-type-uri*
                 *tm2rdf-association-type-uri*
-                *tm2rdf-role-type-uri*)
+                *tm2rdf-role-type-uri*
+                *tm2rdf-association-reifier-property*)
   (:import-from :isidorus-threading
                 with-reader-lock
@@ -443 +444 @@
       (cxml:attribute "rdf:nodeID" (make-object-id association))
       (make-isi-type *tm2rdf-association-type-uri*)
+      (when (reifier association)
+        (cxml:with-element *tm2rdf-association-reifier-property*
+          (make-topic-reference (reifier association))))
       (cxml:with-element "isi:associationtype"
         (make-topic-reference association-type))
@@ -459 +463 @@
       (cxml:with-element "rdf:Description"
         (cxml:attribute "rdf:nodeID" (make-object-id construct))
-        ;(cxml:attribute "rdf:parseType" "Resource")
+        (when (reifier construct)
+          (cxml:with-element *tm2rdf-association-reifier-property*
+            (make-topic-reference (reifier construct))))
         (make-isi-type *tm2rdf-role-type-uri*)
         (map 'list #'to-rdf-elem ii)
@@ -472 +478 @@
    This is indicated by the existence of exactly two roles. One
    of the type isi:object, the other of the type isi:subject.
-   Scopes or itemIdentifiers are also forbidden."
+   Scopes or itemIdentifiers are also forbidden.
+   If the contained roles own any reifiers they are ignored."
   (declare (AssociationC association))
   (let ((isi-subject (get-item-by-psi *rdf2tm-subject*))
@@ -486 +493 @@
                  (= (length association-roles) 2))
         (with-property association
+          (when (reifier association)
+            (let ((reifier-uri (get-reifier-uri (reifier association))))
+              (when reifier-uri
+                (cxml:attribute "rdf:ID" reifier-uri))))
           (make-topic-reference (player object-role)))))))
 

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

@@ -106 +106 @@
                                    *tm2rdf-role-property*
                                    *rdf2tm-subject*)))
-    (let ((players
-           (get-players-by-role-type role-assocs start-revision
-                                     *rdf2tm-object*)))
+    (let ((players-and-reifiers
+           (get-players-and-reifiers-by-role-type
+            role-assocs start-revision *rdf2tm-object*))) 
       (map 'list #'d::delete-construct role-assocs)
-      players)))
-
-
-(defun map-isi-role(role-top start-revision)
+      players-and-reifiers)))
+
+
+(defun map-isi-role(role-top reifier-topic start-revision)
   "Maps a passed topic with all its isidorus:types to a
    property list representing an association-role."
@@ -145 +145 @@
         (list :instance-of (first types)
               :player (first role-players)
-              :item-identifiers ids)))))
+              :item-identifiers ids
+              :reifier reifier-topic)))))
 
 
@@ -160 +161 @@
           assoc-top start-revision *tm2rdf-associationtype-property*
           *rdf2tm-subject*))
+        (reifier-assocs
+         (get-associations-by-type
+          assoc-top start-revision *tm2rdf-association-reifier-property*
+          *rdf2tm-subject*))
         (scope-assocs
          (get-associations-by-type
           assoc-top start-revision *tm2rdf-scope-property*
           *rdf2tm-subject*))
-        (role-tops (get-isi-roles assoc-top start-revision)))
+        (role-and-reifier-topics (get-isi-roles assoc-top start-revision)))
     (let ((types (get-players-by-role-type
                   type-assocs start-revision *rdf2tm-object*))
           (scopes (get-players-by-role-type
                    scope-assocs start-revision *rdf2tm-object*))
+          (reifier-topics (get-players-by-role-type
+                           reifier-assocs start-revision  *rdf2tm-object*))
           (assoc-roles 
            (remove-if #'null (map 'list 
-                                  #'(lambda(role-top)
-                                      (map-isi-role role-top start-revision))
-                                  role-tops))))
+                                  #'(lambda(role-and-reifier)
+                                      (map-isi-role (getf role-and-reifier :player)
+                                                    (getf role-and-reifier :reifier)
+                                                    start-revision))
+                                  role-and-reifier-topics))))
       (elephant:ensure-transaction  (:txn-nosync t)
         (map 'list #'d::delete-construct type-assocs)
@@ -188 +197 @@
           (add-to-topicmap
            xml-importer::tm
-           (make-construct 'AssociationC
-                           :start-revision start-revision
-                           :item-identifiers ids
-                           :instance-of (first types)
-                           :themes scopes
-                           :roles assoc-roles)))))))
+           (let ((association
+                  (make-construct 'AssociationC
+                                  :start-revision start-revision
+                                  :item-identifiers ids
+                                  :instance-of (first types)
+                                  :themes scopes
+                                  :roles assoc-roles)))
+             (map 'list #'(lambda(association-role)
+                            (let ((found-item
+                                   (find-if #'(lambda(list-item)
+                                                (and (eql (instance-of association-role)
+                                                          (getf list-item :instance-of))
+                                                     (eql (player association-role)
+                                                          (getf list-item :player))
+                                                     (getf list-item :reifier)))
+                                            assoc-roles)))
+                              (when found-item
+                                (add-reifier association-role (getf found-item :reifier)))))
+                  (roles association))
+             (when reifier-topics
+               (add-reifier association (first reifier-topics)))
+             association)))))))
 
 
@@ -208 +233 @@
                        :id-type-uri *tm2rdf-subjectlocator-property*))
         (new-item-ids (map-isi-identifiers top start-revision))
-        (occurrence-topics (get-isi-occurrences top start-revision))
-        (name-topics (get-isi-names top start-revision)))
+        (occurrence-and-reifier-topics (get-isi-occurrences top start-revision))
+        (name-and-reifier-topics (get-isi-names top start-revision)))
     (bound-subject-identifiers top new-psis)
     (bound-subject-locators top new-locators)
     (bound-item-identifiers top new-item-ids)
-    (map 'list #'(lambda(occ-top)
-                   (map-isi-occurrence top occ-top start-revision))
-         occurrence-topics)
-    (map 'list #'(lambda(name-top)
-                   (map-isi-name top name-top start-revision))
-         name-topics))
+    (map 'list #'(lambda(occurrence-and-reifier)
+                   (map-isi-occurrence top (getf occurrence-and-reifier :player)
+                                       (getf occurrence-and-reifier :reifier)
+                                       start-revision))
+         occurrence-and-reifier-topics)
+    (map 'list #'(lambda(name-and-reifier)
+                   (map-isi-name top (getf name-and-reifier :player)
+                                 (getf name-and-reifier :reifier)
+                                 start-revision))
+         name-and-reifier-topics))
   top)
 
@@ -230 +259 @@
                                    *tm2rdf-variant-property*
                                    *rdf2tm-subject*)))
-    (let ((players
-           (get-players-by-role-type variant-assocs start-revision
-                                     *rdf2tm-object*)))
+    (let ((players-and-reifiers
+           (get-players-and-reifiers-by-role-type
+            variant-assocs start-revision *rdf2tm-object*)))
       (map 'list #'d::delete-construct variant-assocs)
-      players)))
-
-
-(defun map-isi-variant (name variant-top start-revision)
+      players-and-reifiers)))
+
+
+(defun map-isi-variant (name variant-top reifier-topic start-revision)
   "Maps the passed variant-topic to a TM variant."
   (declare (TopicC variant-top))
@@ -265 +294 @@
         (delete-related-associations variant-top)
         (d::delete-construct variant-top)
-        (make-construct 'VariantC
-                        :start-revision start-revision
-                        :item-identifiers ids
-                        :themes scopes
-                        :charvalue (getf value-and-datatype :value)
-                        :datatype (getf value-and-datatype :datatype)
-                        :name name)))))
-
-
-(defun map-isi-name (top name-top start-revision)
+        (let ((variant
+               (make-construct 'VariantC
+                               :start-revision start-revision
+                               :item-identifiers ids
+                               :themes scopes
+                               :charvalue (getf value-and-datatype :value)
+                               :datatype (getf value-and-datatype :datatype)
+                               :name name)))
+          (add-reifier variant reifier-topic)
+          variant)))))
+
+
+(defun map-isi-name (top name-top reifier-topic start-revision)
   "Maps the passed occurrence-topic to a TM occurrence."
   (declare (TopicC top name-top))
@@ -289 +321 @@
         (value-type-topic 
          (get-item-by-psi *tm2rdf-value-property*))
-        (variant-topics (get-isi-variants name-top start-revision)))
-    (let ((types (let ((fn-types
+        (variant-and-reifier-topics (get-isi-variants name-top start-revision)))
+    (let ((type (let ((fn-types
                         (get-players-by-role-type
                          type-assocs start-revision *rdf2tm-object*)))
@@ -312 +344 @@
                                     :topic top
                                     :charvalue value
-                                    :instance-of types
+                                    :instance-of type
                                     :item-identifiers ids
                                     :themes scopes)))
-          (map 'list #'(lambda(variant-top)
-                         (map-isi-variant name variant-top start-revision))
-               variant-topics)
+          (add-reifier name reifier-topic)
+          (map 'list #'(lambda(variant-and-reifier)
+                         (map-isi-variant name (getf variant-and-reifier :player)
+                                          (getf variant-and-reifier :reifier)
+                                          start-revision))
+               variant-and-reifier-topics)
           (delete-related-associations name-top)
           (d::delete-construct name-top)
@@ -330 +365 @@
                  top start-revision *tm2rdf-name-property*
                  *rdf2tm-subject*)))
-    (let ((occ-tops (get-players-by-role-type
-                     assocs start-revision *rdf2tm-object*)))
+    (let ((name-and-reifier-topics
+           (get-players-and-reifiers-by-role-type
+            assocs start-revision *rdf2tm-object*)))
       (map 'list #'d::delete-construct assocs)
-      occ-tops)))
-
-
-(defun map-isi-occurrence(top occ-top start-revision)
+      name-and-reifier-topics)))
+
+
+(defun map-isi-occurrence(top occ-top reifier-topic start-revision)
   "Maps all topics that represents occurrences of the passed topic top
    to occurrence objects."
@@ -375 +411 @@
         (delete-related-associations occ-top)
         (d::delete-construct occ-top)
-        (make-construct 'OccurrenceC
-                        :start-revision start-revision
-                        :topic top
-                        :themes scopes
-                        :item-identifiers ids
-                        :instance-of (first types)
-                        :charvalue (getf value-and-datatype :value)
-                        :datatype (getf value-and-datatype :datatype))))))
+        (let ((occurrence
+               (make-construct 'OccurrenceC
+                               :start-revision start-revision
+                               :topic top
+                               :themes scopes
+                               :item-identifiers ids
+                               :instance-of (first types)
+                               :charvalue (getf value-and-datatype :value)
+                               :datatype (getf value-and-datatype :datatype))))
+          (add-reifier occurrence reifier-topic)
+          occurrence)))))
 
 
@@ -392 +431 @@
                  top start-revision *tm2rdf-occurrence-property*
                  *rdf2tm-subject*)))
-    (let ((occ-tops (get-players-by-role-type
-                     assocs start-revision *rdf2tm-object*)))
+    (let ((occurrences-and-reifiers
+           (get-players-and-reifiers-by-role-type
+            assocs start-revision *rdf2tm-object*)))
       (map 'list #'d::delete-construct assocs)
-      occ-tops)))
+      occurrences-and-reifiers)))
 
 
@@ -469 +509 @@
                  associations))))
       players)))
+
+
+(defun get-players-and-reifiers-by-role-type (associations start-revision
+                                             role-type-psi)
+  "Returns tuples of the form (:player <player> :reifier <reifier>)"
+    (declare (list associations))
+  (declare (integer start-revision))
+  (declare (string role-type-psi))
+  (let ((role-type (get-item-by-psi role-type-psi
+                                    :revision start-revision)))
+    (let ((tuples
+           (remove-if
+            #'null
+            (map 'list
+                 #'(lambda(assoc)
+                     (let ((role 
+                            (find-if #'(lambda(role)
+                                         (eql role-type (instance-of role)))
+                                     (roles assoc))))
+                       (when role
+                         (let ((reifier-topic (reifier assoc)))
+                           (list :player (player role)
+                                 :reifier reifier-topic)))))
+                 associations))))
+      tuples)))
   
 

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

@@ -55 +55 @@
                 *tm2rdf-player-property*
                 *tm2rdf-associationtype-property*
-                *rdf2tm-blank-node-prefix*)
+                *rdf2tm-blank-node-prefix*
+                *tm2rdf-association-reifier-property*)
   (:import-from :xml-constants
                 *rdf_core_psis.xtm*