Author: lgiessmann Date: Tue Dec 1 07:50:56 2009 New Revision: 156 Log: added a mapping-schema for reification (tm->rdf; rdf->tm) to the rdf-module; unit-tests are currently missing Modified: trunk/src/constants.lisp trunk/src/model/datamodel.lisp trunk/src/xml/rdf/exporter.lisp trunk/src/xml/rdf/map_to_tm.lisp trunk/src/xml/rdf/rdf_tools.lisp Modified: trunk/src/constants.lisp ============================================================================== --- trunk/src/constants.lisp (original) +++ trunk/src/constants.lisp Tue Dec 1 07:50:56 2009 @@ -62,7 +62,8 @@ :*tm2rdf-roletype-property* :*tm2rdf-associationtype-property* :*tm2rdf-player-property* - :*rdf2tm-blank-node-prefix*)) + :*rdf2tm-blank-node-prefix* + :*tm2rdf-association-reifier-property*)) (in-package :constants) @@ -171,3 +172,5 @@ (defparameter *tm2rdf-associationtype-property* (concatenate 'string *tm2rdf-ns* "associationtype")) (defparameter *tm2rdf-player-property* (concatenate 'string *tm2rdf-ns* "player")) + +(defparameter *tm2rdf-association-reifier-property* (concatenate 'string *tm2rdf-ns* "association-reifier")) Modified: trunk/src/model/datamodel.lisp ============================================================================== --- trunk/src/model/datamodel.lisp (original) +++ trunk/src/model/datamodel.lisp Tue Dec 1 07:50:56 2009 @@ -641,7 +641,8 @@ (dolist (id (item-identifiers construct)) (delete-construct id)) (when (reifier construct) - (slot-makunbound (reifier construct) 'reified))) + (remove-reifier construct))) + ;(slot-makunbound (reifier construct) 'reified))) (defgeneric item-identifiers-p (constr) (:documentation "Test for the existence of item identifiers") Modified: trunk/src/xml/rdf/exporter.lisp ============================================================================== --- trunk/src/xml/rdf/exporter.lisp (original) +++ trunk/src/xml/rdf/exporter.lisp Tue Dec 1 07:50:56 2009 @@ -26,7 +26,8 @@ *tm2rdf-occurrence-type-uri* *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 with-writer-lock) @@ -442,6 +443,9 @@ (cxml:with-element "rdf:Description" (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)) (map 'list #'to-rdf-elem ii) @@ -458,7 +462,9 @@ (cxml:with-element "isi:role" (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) (cxml:with-element "isi:roletype" @@ -471,7 +477,8 @@ "Exports an TM association as RDF that was imported from RDF. 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*)) (isi-object (get-item-by-psi *rdf2tm-object*)) @@ -485,6 +492,10 @@ (when (and subject-role object-role (= (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))))))) Modified: trunk/src/xml/rdf/map_to_tm.lisp ============================================================================== --- trunk/src/xml/rdf/map_to_tm.lisp (original) +++ trunk/src/xml/rdf/map_to_tm.lisp Tue Dec 1 07:50:56 2009 @@ -105,14 +105,14 @@ (get-associations-by-type assoc-top start-revision *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))) + players-and-reifiers))) -(defun map-isi-role(role-top start-revision) +(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." (declare (TopicC role-top)) @@ -144,7 +144,8 @@ (d::delete-construct role-top) (list :instance-of (first types) :player (first role-players) - :item-identifiers ids))))) + :item-identifiers ids + :reifier reifier-topic))))) (defun map-isi-association(assoc-top start-revision tm-id @@ -159,20 +160,28 @@ (get-associations-by-type 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) (map 'list #'d::delete-construct scope-assocs) @@ -187,12 +196,28 @@ (with-tm (start-revision document-id tm-id) (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))))))) (defun map-isi-topic(top start-revision) @@ -207,17 +232,21 @@ top start-revision :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) @@ -229,14 +258,14 @@ (get-associations-by-type name-top start-revision *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))) + players-and-reifiers))) -(defun map-isi-variant (name variant-top start-revision) +(defun map-isi-variant (name variant-top reifier-topic start-revision) "Maps the passed variant-topic to a TM variant." (declare (TopicC variant-top)) (declare (NameC name)) @@ -264,16 +293,19 @@ (map 'list #'d::delete-construct scope-assocs) (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))))) + (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 start-revision) +(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)) (declare (integer start-revision)) @@ -288,8 +320,8 @@ *rdf2tm-subject*)) (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*))) (when fn-types @@ -311,12 +343,15 @@ :start-revision start-revision :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) name))))) @@ -329,13 +364,14 @@ (let ((assocs (get-associations-by-type 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))) + name-and-reifier-topics))) -(defun map-isi-occurrence(top occ-top start-revision) +(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." (declare (TopicC top occ-top)) @@ -374,14 +410,17 @@ err-pref (length types))) (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))))) (defun get-isi-occurrences(top start-revision) @@ -391,10 +430,11 @@ (let ((assocs (get-associations-by-type 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))) (defun get-isi-topics (tm-id start-revision @@ -468,6 +508,31 @@ (player role)))) 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))) (defun get-occurrences-by-type (top start-revision Modified: trunk/src/xml/rdf/rdf_tools.lisp ============================================================================== --- trunk/src/xml/rdf/rdf_tools.lisp (original) +++ trunk/src/xml/rdf/rdf_tools.lisp Tue Dec 1 07:50:56 2009 @@ -54,7 +54,8 @@ *tm2rdf-roletype-property* *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* *core_psis.xtm*)