[isidorus-cvs] r136 - in trunk/src: . unit_tests xml/rdf
Lukas Giessmann
lgiessmann at common-lisp.net
Tue Sep 8 08:51:37 UTC 2009
Author: lgiessmann
Date: Tue Sep 8 04:51:36 2009
New Revision: 136
Log:
rdf-exporter: fixed a bug with missing name-types; rdf-importer: fixed a bug with merging/versioning of blank_nodes --> they get an item-identifier concatenated of a predefined prefix and their nodeID or a UUID
Modified:
trunk/src/constants.lisp
trunk/src/unit_tests/full_mapping.rdf
trunk/src/xml/rdf/exporter.lisp
trunk/src/xml/rdf/importer.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 Sep 8 04:51:36 2009
@@ -61,7 +61,8 @@
:*tm2rdf-occurrencetype-property*
:*tm2rdf-roletype-property*
:*tm2rdf-associationtype-property*
- :*tm2rdf-player-property*))
+ :*tm2rdf-player-property*
+ :*rdf2tm-blank-node-prefix*))
(in-package :constants)
@@ -123,6 +124,8 @@
(defparameter *rdf2tm-scope-prefix* (concatenate 'string *rdf2tm-ns* "scope/"))
+(defparameter *rdf2tm-blank-node-prefix* (concatenate 'string *rdf2tm-ns* "blank_node/"))
+
(defparameter *tm2rdf-ns* "http://isidorus/tm2rdf_mapping/")
(defparameter *tm2rdf-topic-type-uri* (concatenate 'string *tm2rdf-ns* "types/Topic"))
Modified: trunk/src/unit_tests/full_mapping.rdf
==============================================================================
--- trunk/src/unit_tests/full_mapping.rdf (original)
+++ trunk/src/unit_tests/full_mapping.rdf Tue Sep 8 04:51:36 2009
@@ -64,7 +64,7 @@
</isi:variant>
</rdf:Description>
</isi:name>
- <!-- <isi:name rdf:resource="id_2345"/> --> <!-- should be merged with id_266 -->
+ <isi:name rdf:resource="id_2345"/> <!-- should be merged with id_266 -->
<isi:name>
<rdf:Description rdf:nodeID="id_277">
<rdf:type rdf:resource="http://isidorus/tm2rdf_mapping/types/Name"/>
@@ -102,7 +102,7 @@
<isi:itemIdentity rdf:datatype="http://www.w3.org/2001/XMLSchema#anyURI">http://simpsons/married/ii-1</isi:itemIdentity>
<isi:role>
<rdf:Description rdf:nodeID="id_292">
- <isi:itemIdentity rdf:datatype="">http://simpsons/role-husband/ii</isi:itemIdentity>
+ <isi:itemIdentity rdf:datatype="http://www.w3.org/2001/XMLSchema#anyURI">http://simpsons/role-husband/ii</isi:itemIdentity>
<rdf:type rdf:resource="http://isidorus/tm2rdf_mapping/types/Role"/>
<isi:roletype rdf:resource="http://simpsons/husband"/>
<isi:player rdf:resource="http://simpsons/homer"/>
@@ -117,15 +117,29 @@
</isi:role>
</rdf:Description>
+ <rdf:Description rdf:nodeID="id_295">
+ <isi:itemIdentity rdf:datatype="http://www.w3.org/2001/XMLSchema#anyURI">http://simpsons/role-wife/ii</isi:itemIdentity>
+ </rdf:Description>
+
<rdf:Description>
- <isi:itemIdentity rdf:datatype="">http://simpsons/maried/ii-2</isi:itemIdentity>
+ <rdf:type rdf:resource="http://isidorus/tm2rdf_mapping/types/Association"/>
+ <isi:itemIdentity rdf:datatype="http://www.w3.org/2001/XMLSchema#anyURI">http://simpsons/married/ii-1</isi:itemIdentity>
+ <isi:itemIdentity rdf:datatype="http://www.w3.org/2001/XMLSchema#anyURI">http://simpsons/married/ii-2</isi:itemIdentity>
+ <isi:associationtype rdf:resource="http://simpsons/married"/>
<isi:role>
- <rdf:Description rdf:nodeID="id_295">
- <isi:itemIdentity rdf:datatype="">http://simpsons/role-wife/ii</isi:itemIdentity>
+ <rdf:Description>
+ <isi:itemIdentity rdf:datatype="http://www.w3.org/2001/XMLSchema#anyURI">http://simpsons/role-wife/ii</isi:itemIdentity>
<rdf:type rdf:resource="http://isidorus/tm2rdf_mapping/types/Role"/>
<isi:roletype rdf:resource="http://simpsons/wife"/>
<isi:player rdf:resource="http://simpsons/marge"/>
</rdf:Description>
</isi:role>
+ <isi:role>
+ <rdf:Description>
+ <rdf:type rdf:resource="http://isidorus/tm2rdf_mapping/types/Role"/>
+ <isi:roletype rdf:resource="http://simpsons/husband"/>
+ <isi:player rdf:resource="http://simpsons/homer"/>
+ </rdf:Description>
+ </isi:role>
</rdf:Description>
-</rdf:RDF>
\ No newline at end of file
+</rdf:RDF>
Modified: trunk/src/xml/rdf/exporter.lisp
==============================================================================
--- trunk/src/xml/rdf/exporter.lisp (original)
+++ trunk/src/xml/rdf/exporter.lisp Tue Sep 8 04:51:36 2009
@@ -39,7 +39,7 @@
to be exported, the same mechanism as
in xtm-exporter")
-(defvar *ns-map* nil) ;; ((:prefix <string> :uri <string>))
+(defvar *ns-map* nil "((:prefix <string> :uri <string>))")
(defun rdf-li-or-uri (uri)
@@ -297,8 +297,9 @@
(cxml:attribute "rdf:nodeID" (make-object-id construct))
(make-isi-type *tm2rdf-name-type-uri*)
(map 'list #'to-rdf-elem (item-identifiers construct))
- (cxml:with-element "isi:nametype"
- (make-topic-reference (instance-of construct)))
+ (when (slot-boundp construct 'instance-of)
+ (cxml:with-element "isi:nametype"
+ (make-topic-reference (instance-of construct))))
(scopes-to-rdf-elems construct)
(cxml:with-element "isi:value"
(cxml:attribute "rdf:datatype" *xml-string*)
Modified: trunk/src/xml/rdf/importer.lisp
==============================================================================
--- trunk/src/xml/rdf/importer.lisp (original)
+++ trunk/src/xml/rdf/importer.lisp Tue Sep 8 04:51:36 2009
@@ -411,28 +411,25 @@
If about or ID is set there will also be created a new PSI."
(declare (TopicMapC tm))
(let ((topic-id (or about ID nodeID UUID))
- (psi-uri (or about ID)))
+ (psi-uri (or about ID))
+ (ii-uri (unless (or about ID)
+ (concatenate 'string *rdf2tm-blank-node-prefix*
+ (or nodeID UUID)))))
(let ((top
;seems like there is a bug in d:get-item-by-id:
;this functions returns an emtpy topic although there is no one
- ;with a corresponding topic id and/or version and/or xtm-id
+ ;with a corresponding topic id and/or version.
+ ;Thus the version is temporary checked manually.
(let ((inner-top
(get-item-by-id topic-id :xtm-id document-id
:revision start-revision)))
- ;;(when inner-top
- ;; (let ((versions (d::versions inner-top)))
- ;; (unless (find-if #'(lambda(version)
- ;; (= start-revision
- ;; (d::start-revision version)))
- ;; versions)
- ;; (d::add-to-version-history inner-top
- ;; :start-revision start-revision)
- ;; (add-to-topicmap tm inner-top)))))))
- (when (and inner-top
- (find-if #'(lambda(x)
- (= (d::start-revision x) start-revision))
- (d::versions inner-top)))
- inner-top))))
+ (when inner-top
+ (let ((versions (d::versions inner-top)))
+ (when (find-if #'(lambda(version)
+ (= start-revision
+ (d::start-revision version)))
+ versions)
+ inner-top))))))
(if top
top
(elephant:ensure-transaction (:txn-nosync t)
@@ -440,7 +437,12 @@
(list
(make-instance 'PersistentIdC
:uri psi-uri
- :start-revision start-revision)))))
+ :start-revision start-revision))))
+ (iis (when ii-uri
+ (list
+ (make-instance 'ItemIdentifierC
+ :uri ii-uri
+ :start-revision start-revision)))))
(handler-case (let ((top
(add-to-topicmap
tm
@@ -448,6 +450,7 @@
'TopicC
:topicid topic-id
:psis psis
+ :item-identifiers iis
:xtm-id document-id
:start-revision start-revision))))
(format t "t")
@@ -463,12 +466,12 @@
(when lang
(let ((psi-and-topic-id
(concatenate-uri *rdf2tm-scope-prefix* lang)))
- (let ((top (get-item-by-id psi-and-topic-id :xtm-id document-id
- :revision start-revision)))
- (if top
- top
- (make-topic-stub psi-and-topic-id nil nil nil start-revision
- tm :document-id document-id))))))
+ ;(let ((top (get-item-by-id psi-and-topic-id :xtm-id document-id
+; :revision start-revision)))
+; (if top
+; top
+ (make-topic-stub psi-and-topic-id nil nil nil start-revision
+ tm :document-id document-id))))
(defun make-association (top association tm start-revision
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 Sep 8 04:51:36 2009
@@ -71,13 +71,15 @@
(type-instance (get-item-by-psi *type-instance-psi*))
(type (get-item-by-psi *type-psi*)))
(declare (TopicC instance-topic type-topic))
- (let ((assocs (map 'list
- #'(lambda(role)
- (when (and (eql (instance-of role) instance)
- (eql (instance-of (parent role))
- type-instance))
- (parent role)))
- (player-in-roles instance-topic))))
+ (let ((assocs (remove-if
+ #'null
+ (map 'list
+ #'(lambda(role)
+ (when (and (eql (instance-of role) instance)
+ (eql (instance-of (parent role))
+ type-instance))
+ (parent role)))
+ (player-in-roles instance-topic)))))
(map 'list #'(lambda(assoc)
(when (find-if #'(lambda(role)
(and (eql (instance-of role) type)
@@ -86,6 +88,13 @@
(d::delete-construct assoc)))
assocs)
nil))))
+
+
+(defun delete-related-associations (top)
+ "Deletes all associaitons related to the passed topic."
+ (dolist (assoc-role (player-in-roles top))
+ (d::delete-construct (parent assoc-role)))
+ top)
(defun get-isi-roles(assoc-top start-revision)
@@ -109,8 +118,6 @@
(declare (TopicC role-top))
(declare (integer start-revision))
(let ((err-pref "From map-isi-role(): ")
- (role-type-topic (get-item-by-psi *tm2rdf-role-type-uri*
- :revision start-revision))
(ids (map-isi-identifiers role-top start-revision))
(type-assocs
(get-associations-by-type
@@ -133,7 +140,7 @@
(when (= 0 (length role-players))
(error "~aexpect one player but found: ~a"
err-pref (length role-players)))
- (delete-instance-of-association role-top role-type-topic)
+ (delete-related-associations role-top)
(d::delete-construct role-top)
(list :instance-of (first types)
:player (first role-players)
@@ -175,6 +182,7 @@
(when (= 0 (length assoc-roles))
(error "~aexpect at least one role but found: ~a"
err-pref (length assoc-roles)))
+ (delete-related-associations assoc-top)
(d::delete-construct assoc-top)
(with-tm (start-revision document-id tm-id)
(add-to-topicmap
@@ -234,8 +242,6 @@
(declare (NameC name))
(declare (integer start-revision))
(let ((ids (map-isi-identifiers variant-top start-revision))
- (variant-type-topic (get-item-by-psi *tm2rdf-variant-type-uri*
- :revision start-revision))
(scope-assocs
(get-associations-by-type
variant-top start-revision *tm2rdf-scope-property*
@@ -256,7 +262,7 @@
:datatype *xml-string*)))))
(elephant:ensure-transaction (:txn-nosync t)
(map 'list #'d::delete-construct scope-assocs)
- (delete-instance-of-association variant-top variant-type-topic)
+ (delete-related-associations variant-top)
(d::delete-construct variant-top)
(make-construct 'VariantC
:start-revision start-revision
@@ -272,8 +278,6 @@
(declare (TopicC top name-top))
(declare (integer start-revision))
(let ((err-pref "From map-isi-name(): ")
- (name-type-topic (get-item-by-psi *tm2rdf-name-type-uri*
- :revision start-revision))
(ids (map-isi-identifiers name-top start-revision))
(type-assocs
(get-associations-by-type
@@ -314,7 +318,7 @@
(map 'list #'(lambda(variant-top)
(map-isi-variant name variant-top start-revision))
variant-topics)
- (delete-instance-of-association name-top name-type-topic)
+ (delete-related-associations name-top)
(d::delete-construct name-top)
name)))))
@@ -339,8 +343,6 @@
(declare (integer start-revision))
(let ((err-pref "From map-isi-occurrence(): ")
(ids (map-isi-identifiers occ-top start-revision))
- (occurrence-type-topic (get-item-by-psi *tm2rdf-occurrence-type-uri*
- :revision start-revision))
(type-assocs
(get-associations-by-type
occ-top start-revision *tm2rdf-occurrencetype-property*
@@ -371,7 +373,7 @@
(when (/= 1 (length types))
(error "~aexpect one type topic but found: ~a"
err-pref (length types)))
- (delete-instance-of-association occ-top occurrence-type-topic)
+ (delete-related-associations occ-top)
(d::delete-construct occ-top)
(make-construct 'OccurrenceC
:start-revision 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 Sep 8 04:51:36 2009
@@ -53,7 +53,8 @@
*tm2rdf-occurrencetype-property*
*tm2rdf-roletype-property*
*tm2rdf-player-property*
- *tm2rdf-associationtype-property*)
+ *tm2rdf-associationtype-property*
+ *rdf2tm-blank-node-prefix*)
(:import-from :xml-constants
*rdf_core_psis.xtm*
*core_psis.xtm*)
@@ -509,4 +510,4 @@
(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 xml-base)))))
+ (get-types-of-node-content elem tm-id xml-base)))))
\ No newline at end of file
More information about the Isidorus-cvs
mailing list