[isidorus-cvs] r156 - in trunk/src: . model xml/rdf
Lukas Giessmann
lgiessmann at common-lisp.net
Tue Dec 1 12:50:57 UTC 2009
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*)
More information about the Isidorus-cvs
mailing list