[isidorus-cvs] r296 - in branches/new-datamodel/src: model unit_tests xml/xtm
Lukas Giessmann
lgiessmann at common-lisp.net
Wed Jun 9 20:35:08 UTC 2010
Author: lgiessmann
Date: Wed Jun 9 16:35:07 2010
New Revision: 296
Log:
new-datamodel: adapted importer_xtm1.0.lisp and importer_xtm2.0.lisp to the new datamodel
Modified:
branches/new-datamodel/src/model/changes.lisp
branches/new-datamodel/src/model/datamodel.lisp
branches/new-datamodel/src/unit_tests/atom_test.lisp
branches/new-datamodel/src/xml/xtm/importer.lisp
branches/new-datamodel/src/xml/xtm/importer_xtm1.0.lisp
branches/new-datamodel/src/xml/xtm/importer_xtm2.0.lisp
Modified: branches/new-datamodel/src/model/changes.lisp
==============================================================================
--- branches/new-datamodel/src/model/changes.lisp (original)
+++ branches/new-datamodel/src/model/changes.lisp Wed Jun 9 16:35:07 2010
@@ -71,7 +71,7 @@
(when (reifier characteristic :revision revision)
(list (reifier characteristic :revision revision)))
(themes characteristic :revision revision)
- (when (instance-of-p characteristic :revision revision)
+ (when (instance-of characteristic :revision revision)
(list (instance-of characteristic :revision revision)))
(when (and (typep characteristic 'OccurrenceC)
(> (length (charvalue characteristic)) 0)
Modified: branches/new-datamodel/src/model/datamodel.lisp
==============================================================================
--- branches/new-datamodel/src/model/datamodel.lisp (original)
+++ branches/new-datamodel/src/model/datamodel.lisp Wed Jun 9 16:35:07 2010
@@ -1208,6 +1208,13 @@
;;; PointerC
+(defmethod versions ((construct PointerC))
+ "Returns all versions that are indirectly through all PointerAssocitiations
+ bound to the passed pointer object."
+ (loop for p-assoc in (slot-p construct 'identified-construct)
+ append (versions p-assoc)))
+
+
(defmethod mark-as-deleted ((construct PointerC) &key source-locator revision)
"Marks the last active relation between a pointer and its parent construct
as deleted."
@@ -2177,6 +2184,13 @@
;;; CharacteristicC
+(defmethod versions ((construct CharacteristicC))
+ "Returns all versions that are indirectly through all
+ CharacteristicAssocitiations bound to the passed characteristic object."
+ (loop for p-assoc in (slot-p construct 'parent)
+ append (versions p-assoc)))
+
+
(defmethod mark-as-deleted ((construct CharacteristicC) &key source-locator revision)
"Marks the last active relation between a characteristic and its parent topic
as deleted."
Modified: branches/new-datamodel/src/unit_tests/atom_test.lisp
==============================================================================
--- branches/new-datamodel/src/unit_tests/atom_test.lisp (original)
+++ branches/new-datamodel/src/unit_tests/atom_test.lisp Wed Jun 9 16:35:07 2010
@@ -58,7 +58,7 @@
(atom:subfeeds atom:*tm-feed*)
:test #'string=
:key #'atom:id))
- (datetime-revision3
+ (datetime-revision3
(atom::datetime-in-iso-format fixtures::revision3))
(datetime-revision1
(atom::datetime-in-iso-format fixtures::revision1))
@@ -66,7 +66,7 @@
(format nil "<a:feed xmlns:a=\"http://www.w3.org/2005/Atom\" xmlns:e=\"http://www.egovpt.org/sdshare/\"><a:title>Topicmaps on psi.egovpt.org</a:title><a:id>http://london.ztt.fh-worms.de:8000/feeds</a:id><a:author><a:name>Isidor</a:name></a:author><a:link href=\"http://london.ztt.fh-worms.de:8000/feeds\" rel=\"self\"></a:link><a:updated>~a</a:updated><a:entry xmlns:a=\"http://www.w3.org/2005/Atom\" xmlns:e=\"http://www.egovpt.org/sdshare/\"><a:title>Data behind the portal of the city of Worms</a:title><a:id>http://psi.egovpt.org/tm/worms/entry</a:id><a:link href=\"http://london.ztt.fh-worms.de:8000/feeds/worms\" rel=\"alternate\"></a:link><a:link href=\"http://london.ztt.fh-worms.de:8000/feeds/worms\" rel=\"alternate\" type=\"application/atom+xml\"></a:link><a:author><a:name>Isidor</a:name></a:author><a:link href=\"http://london.ztt.fh-worms.de:8000/feeds/worms\" rel=\"http://www.egovpt.org/sdshare/collectionfeed\" type=\"application/atom+xml\"></a:link><a:updated>~a</a:updated></a:entry><a:entry xmlns:a=\"http://www.w3.org/2005/Atom\" xmlns:e=\"http://www.egovpt.org/sdshare/\"><a:title>eGov Reference Ontology</a:title><a:id>http://psi.egovpt.org/tm/egov-ontology/entry</a:id><a:link href=\"http://london.ztt.fh-worms.de:8000/feeds/egov-ontology\" rel=\"alternate\"></a:link><a:link href=\"http://london.ztt.fh-worms.de:8000/feeds/egov-ontology\" rel=\"alternate\" type=\"application/atom+xml\"></a:link><a:author><a:name>Isidor</a:name></a:author><a:link href=\"http://london.ztt.fh-worms.de:8000/feeds/egov-ontology\" rel=\"http://www.egovpt.org/sdshare/collectionfeed\" type=\"application/atom+xml\"></a:link><a:updated>~a</a:updated></a:entry></a:feed>" datetime-revision3 datetime-revision3 datetime-revision1))
(worms-feed-string
(format nil "<a:feed xmlns:a=\"http://www.w3.org/2005/Atom\" xmlns:e=\"http://www.egovpt.org/sdshare/\"><a:title>Data behind the portal of the city of Worms</a:title><a:id>http://london.ztt.fh-worms.de:8000/feeds/worms</a:id><a:author><a:name>Isidor</a:name></a:author><a:link href=\"http://london.ztt.fh-worms.de:8000/feeds/worms\" rel=\"self\"></a:link><e:dependency>http://london.ztt.fh-worms.de:8000/feeds/egov-ontology</e:dependency><a:updated>~a</a:updated><a:entry xmlns:a=\"http://www.w3.org/2005/Atom\" xmlns:e=\"http://www.egovpt.org/sdshare/\"><a:title>Snapshots of the Worms data</a:title><a:id>http://psi.egovpt.org/tm/worms/snapshots/entry</a:id><a:link href=\"http://london.ztt.fh-worms.de:8000/feeds/worms/snapshots\" rel=\"alternate\"></a:link><a:link href=\"http://london.ztt.fh-worms.de:8000/feeds/worms/snapshots\" rel=\"http://www.egovpt.org/sdshare/snapshotsfeed\" type=\"application/atom+xml\"></a:link><a:updated>~a</a:updated></a:entry><a:entry xmlns:a=\"http://www.w3.org/2005/Atom\" xmlns:e=\"http://www.egovpt.org/sdshare/\"><a:title>A list of all change fragments for the Worms data</a:title><a:id>http://psi.egovpt.org/tm/worms/fragments/entry</a:id><a:link href=\"http://london.ztt.fh-worms.de:8000/feeds/worms/fragments\" rel=\"alternate\"></a:link><a:link href=\"http://london.ztt.fh-worms.de:8000/feeds/worms/fragments\" rel=\"http://www.egovpt.org/sdshare/fragmentsfeed\" type=\"application/atom+xml\"></a:link><a:updated>~a</a:updated></a:entry></a:feed>" datetime-revision3 datetime-revision3 datetime-revision3)))
- (is
+ (is
(string=
collection-feed-string
(cxml:with-xml-output
Modified: branches/new-datamodel/src/xml/xtm/importer.lisp
==============================================================================
--- branches/new-datamodel/src/xml/xtm/importer.lisp (original)
+++ branches/new-datamodel/src/xml/xtm/importer.lisp Wed Jun 9 16:35:07 2010
@@ -94,11 +94,11 @@
(error "cannot handle topicrefs that don't start with #"))
(subseq topicref 1)))
-(defun get-topicid-by-psi (uri &key (xtm-id d:*current-xtm*))
+(defun get-topicid-by-psi (uri &key (xtm-id d:*current-xtm*) (revision *TM-REVISION*))
(when uri
(loop for item in
(topic-identifiers
- (identified-construct (elephant:get-instance-by-value 'PersistentIdC 'uri uri)))
+ (identified-construct (elephant:get-instance-by-value 'PersistentIdC 'uri uri)) :revision revision)
when (string= xtm-id (xtm-id item))
return (uri item))))
@@ -172,19 +172,17 @@
(declare (TopicMapC tm))
(let
((associationtype
- (get-item-by-psi *type-instance-psi*))
+ (get-item-by-psi *type-instance-psi* :revision start-revision))
(roletype1
- (get-item-by-psi *type-psi*))
+ (get-item-by-psi *type-psi* :revision start-revision))
(roletype2
- (get-item-by-psi *instance-psi*))
+ (get-item-by-psi *instance-psi* :revision start-revision))
(player1
(get-item-by-id topicid-of-supertype
:xtm-id xtm-id
:revision start-revision)))
-
(unless (and associationtype roletype1 roletype2)
(error "Error in the creation of an instanceof association: core topics are missing"))
-
(unless player1
(error
(make-condition 'missing-reference-error
Modified: branches/new-datamodel/src/xml/xtm/importer_xtm1.0.lisp
==============================================================================
--- branches/new-datamodel/src/xml/xtm/importer_xtm1.0.lisp (original)
+++ branches/new-datamodel/src/xml/xtm/importer_xtm1.0.lisp Wed Jun 9 16:35:07 2010
@@ -9,7 +9,7 @@
(in-package :xml-importer)
-(defun get-reifier-topic-xtm1.0 (reifiable-elem)
+(defun get-reifier-topic-xtm1.0 (reifiable-elem start-revision)
"Returns a reifier topic of the reifiable-element or nil."
(declare (dom:element reifiable-elem))
(let ((reifier-uri
@@ -21,7 +21,7 @@
(elephant:get-instance-by-value 'd:PersistentIdC 'd:uri
(concatenate 'string "#" reifier-uri))))
(when psi
- (let ((reifier-topic (identified-construct psi)))
+ (let ((reifier-topic (identified-construct psi :revision start-revision)))
(when reifier-topic
reifier-topic)))))))
@@ -86,7 +86,7 @@
(parent parent-construct))
(t
(error "from-variant-elem-xtm1.0: parent-construct is neither NameC nor VariantC"))))
- (reifier-topic (get-reifier-topic-xtm1.0 variant-elem)))
+ (reifier-topic (get-reifier-topic-xtm1.0 variant-elem start-revision)))
(unless (and variantName parameters)
(error "from-variant-elem-xtm1.0: parameters and variantName must be set"))
(let ((variant (make-construct 'VariantC
@@ -146,13 +146,12 @@
(let ((themes (when (xpath-single-child-elem-by-qname baseName-elem *xtm1.0-ns* "scope")
(from-scope-elem-xtm1.0
(xpath-single-child-elem-by-qname baseName-elem *xtm1.0-ns* "scope")
- :xtm-id xtm-id)))
+ start-revision :xtm-id xtm-id)))
(baseNameString (xpath-fn-string
(xpath-single-child-elem-by-qname baseName-elem *xtm1.0-ns* "baseNameString")))
- (reifier-topic (get-reifier-topic-xtm1.0 baseName-elem)))
+ (reifier-topic (get-reifier-topic-xtm1.0 baseName-elem start-revision)))
(unless baseNameString
(error "A baseName must have exactly one baseNameString"))
-
(let ((name (make-construct 'NameC
:start-revision start-revision
:topic top
@@ -224,7 +223,7 @@
ref-topic))))
-(defun from-scope-elem-xtm1.0 (scope-elem &key (xtm-id *current-xtm*))
+(defun from-scope-elem-xtm1.0 (scope-elem start-revision &key (xtm-id *current-xtm*))
"returns the topics referenced by this scope element.
the nested elements resourceRef and subjectIndicatorRef are ignored"
(when scope-elem
@@ -238,7 +237,7 @@
(xpath-child-elems-by-qname scope-elem *xtm1.0-ns* "subjectIndicatorRef"))))))
(let ((ref-topics (map 'list
#'(lambda(x)
- (let ((ref-topic (get-item-by-id x :xtm-id xtm-id)))
+ (let ((ref-topic (get-item-by-id x :xtm-id xtm-id :revision start-revision)))
(if ref-topic
ref-topic
(error (make-condition 'missing-reference-error
@@ -261,10 +260,10 @@
(get-item-by-id (first (get-instanceOf-refs-xtm1.0 occ-elem :xtm-id xtm-id)) :xtm-id xtm-id)))
(themes (from-scope-elem-xtm1.0
(xpath-single-child-elem-by-qname occ-elem *xtm1.0-ns* "scope")
- :xtm-id xtm-id))
+ start-revision :xtm-id xtm-id))
(occurrence-value
(from-resourceX-elem-xtm1.0 occ-elem))
- (reifier-topic (get-reifier-topic-xtm1.0 occ-elem)))
+ (reifier-topic (get-reifier-topic-xtm1.0 occ-elem start-revision)))
(unless occurrence-value
(error "from-occurrence-elem-xtm1.0: one of resourceRef and resourceData must be set"))
(unless instanceOf
@@ -294,14 +293,12 @@
(let ((id (make-instance 'PersistentIdC
:uri uri
:start-revision start-revision)))
- ;(add-to-version-history id :start-revision start-revision)
id))
psi-refs))
(locators (map 'list #'(lambda(uri)
(let ((loc (make-instance 'SubjectLocatorC
:uri uri
:start-revision start-revision)))
- ;(add-to-version-history loc :start-revision start-revision)
loc))
locator-refs)))
(declare (dom:element subjectIdentity-elem))
@@ -309,7 +306,7 @@
(list :psis psis :locators locators)))))
-(defun from-member-elem-xtm1.0 (member-elem &key (xtm-id *current-xtm*))
+(defun from-member-elem-xtm1.0 (member-elem start-revision &key (xtm-id *current-xtm*))
"returns a list with the role- type, player and itemIdentities"
(when member-elem
(elephant:ensure-transaction (:txn-nosync t)
@@ -332,7 +329,7 @@
member-elem
*xtm1.0-ns*
"subjectIndicatorRef")))))))
- (reifier-topic (get-reifier-topic-xtm1.0 member-elem)))
+ (reifier-topic (get-reifier-topic-xtm1.0 member-elem start-revision)))
(declare (dom:element member-elem))
(unless player ; if no type is given a standard type will be assigend later in from-assoc...
(error "from-member-elem-xtm1.0: missing player in role"))
@@ -347,8 +344,7 @@
(xtm-id *current-xtm*))
"creates a TopicC instance with a start-revision, all psis, the topicid and the xtm-id"
(declare (dom:element topic-elem))
- (declare (integer start-revision))
- ;(declare (optimize (debug 3)))
+ (declare (integer start-revision))
(elephant:ensure-transaction (:txn-nosync t)
(let ((identifiers (from-subjectIdentity-elem-xtm1.0 (xpath-single-child-elem-by-qname
topic-elem
@@ -407,13 +403,13 @@
(themes
(from-scope-elem-xtm1.0
(xpath-single-child-elem-by-qname assoc-elem *xtm1.0-ns* "scope")
- :xtm-id xtm-id))
+ start-revision :xtm-id xtm-id))
(roles (map 'list
#'(lambda(member-elem)
- (from-member-elem-xtm1.0
- member-elem :xtm-id xtm-id))
+ (from-member-elem-xtm1.0 member-elem start-revision
+ :xtm-id xtm-id))
(xpath-child-elems-by-qname assoc-elem *xtm1.0-ns* "member")))
- (reifier-topic (get-reifier-topic-xtm1.0 assoc-elem)))
+ (reifier-topic (get-reifier-topic-xtm1.0 assoc-elem start-revision)))
(unless roles
(error "from-association-elem-xtm1.0: roles are missing in association"))
(setf roles (set-standard-role-types roles))
@@ -427,8 +423,7 @@
:themes themes
:reifier reifier-topic
:roles roles)))))
-
-
+
(defun set-standard-role-types (roles)
"sets the missing role types of the passed roles to the default types."
Modified: branches/new-datamodel/src/xml/xtm/importer_xtm2.0.lisp
==============================================================================
--- branches/new-datamodel/src/xml/xtm/importer_xtm2.0.lisp (original)
+++ branches/new-datamodel/src/xml/xtm/importer_xtm2.0.lisp Wed Jun 9 16:35:07 2010
@@ -9,7 +9,7 @@
(in-package :xml-importer)
-(defun get-reifier-topic(reifiable-elem)
+(defun get-reifier-topic(reifiable-elem start-revision)
"Returns the reifier topic of the reifierable-element or nil."
(declare (dom:element reifiable-elem))
(let ((reifier-uri (get-attribute reifiable-elem "reifier"))
@@ -19,7 +19,7 @@
(let ((ii
(elephant:get-instance-by-value 'd:ItemIdentifierC 'd:uri reifier-uri)))
(if ii
- (let ((reifier-topic (identified-construct ii)))
+ (let ((reifier-topic (identified-construct ii :revision start-revision)))
(if reifier-topic
reifier-topic
(error "~aitem-identifier ~a not found" err reifier-uri)))
@@ -49,7 +49,7 @@
*xtm2.0-ns* elem-name)))
-(defun from-type-elem (type-elem &key (xtm-id *current-xtm*))
+(defun from-type-elem (type-elem start-revision &key (xtm-id *current-xtm*))
"Returns the topic that reifies this type or nil if no element is
input"
; type = element type { topicRef }
@@ -62,7 +62,7 @@
(xpath-single-child-elem-by-qname
type-elem
*xtm2.0-ns* "topicRef")))
- (top (get-item-by-id topicid :xtm-id xtm-id)))
+ (top (get-item-by-id topicid :xtm-id xtm-id :revision start-revision)))
(declare (dom:element type-elem))
(unless top
(error (make-condition 'missing-reference-error
@@ -70,7 +70,7 @@
top)))
-(defun from-scope-elem (scope-elem &key (xtm-id *current-xtm*))
+(defun from-scope-elem (scope-elem start-revision &key (xtm-id *current-xtm*))
"Generate set of themes (= topics) from this scope element and
return that set. If the input is nil, the list of themes is empty
scope = element scope { topicRef+ }"
@@ -89,15 +89,13 @@
(lambda (topicid)
(let
((top
- (get-item-by-id
- topicid :xtm-id xtm-id)))
+ (get-item-by-id topicid :xtm-id xtm-id :revision start-revision)))
(if top
top
(error (make-condition 'missing-reference-error
:message (format nil "from-scope-elem: could not resolve reference ~a" topicid))))))
topicrefs)))
(declare (dom:element scope-elem))
-
(unless (>= (length tops) 1)
(error "need at least one topic in a scope"))
tops)))
@@ -121,16 +119,15 @@
(themes
(from-scope-elem
(xpath-single-child-elem-by-qname
- name-elem
- *xtm2.0-ns* "scope") :xtm-id xtm-id))
+ name-elem *xtm2.0-ns* "scope")
+ start-revision :xtm-id xtm-id))
(instance-of
(from-type-elem (xpath-single-child-elem-by-qname
name-elem
- *xtm2.0-ns* "type") :xtm-id xtm-id))
- (reifier-topic (get-reifier-topic name-elem)))
+ *xtm2.0-ns* "type") start-revision :xtm-id xtm-id))
+ (reifier-topic (get-reifier-topic name-elem start-revision)))
(unless namevalue
(error "A name must have exactly one namevalue"))
-
(let ((name (make-construct 'NameC
:start-revision start-revision
:topic top
@@ -188,10 +185,11 @@
((item-identifiers (make-identifiers 'ItemIdentifierC variant-elem "itemIdentity" start-revision))
;;all themes of the parent name element are inherited to the variant elements
(themes (append
- (from-scope-elem (xpath-single-child-elem-by-qname variant-elem *xtm2.0-ns* "scope") :xtm-id xtm-id)
+ (from-scope-elem (xpath-single-child-elem-by-qname variant-elem *xtm2.0-ns* "scope")
+ start-revision :xtm-id xtm-id)
(themes name)))
(variant-value (from-resourceX-elem variant-elem))
- (reifier-topic (get-reifier-topic variant-elem)))
+ (reifier-topic (get-reifier-topic variant-elem start-revision)))
(unless variant-value
(error "VariantC: one of resourceRef and resourceData must be set"))
@@ -212,20 +210,18 @@
(declare (dom:element occ-elem))
(declare (TopicC top))
(declare (integer start-revision))
-
(let
((themes
(from-scope-elem (xpath-single-child-elem-by-qname
- occ-elem
- *xtm2.0-ns* "scope")))
+ occ-elem *xtm2.0-ns* "scope") start-revision :xtm-id xtm-id))
(item-identifiers
(make-identifiers 'ItemIdentifierC occ-elem "itemIdentity" start-revision))
(instance-of
(from-type-elem (xpath-single-child-elem-by-qname
occ-elem
- *xtm2.0-ns* "type") :xtm-id xtm-id))
+ *xtm2.0-ns* "type") start-revision :xtm-id xtm-id))
(occurrence-value (from-resourceX-elem occ-elem))
- (reifier-topic (get-reifier-topic occ-elem)))
+ (reifier-topic (get-reifier-topic occ-elem start-revision)))
(unless occurrence-value
(error "OccurrenceC: one of resourceRef and resourceData must be set"))
(make-construct 'OccurrenceC
@@ -267,21 +263,16 @@
(defun merge-topic-elem (topic-elem start-revision
- &key
- tm
- (xtm-id *current-xtm*))
+ &key tm (xtm-id *current-xtm*))
"Adds further elements (names, occurrences) and instanceOf
associations to the topic"
- ;TODO: solve merging through reifying
(declare (dom:element topic-elem))
(declare (integer start-revision))
(declare (TopicMapC tm))
- ;(format t "xtm-id: ~a current-xtm: ~a revision: ~a~&" xtm-id *current-xtm* start-revision)
(elephant:ensure-transaction (:txn-nosync t)
(let
((top ;retrieve the already existing topic stub
- (get-item-by-id
- (get-attribute topic-elem "id")
+ (get-item-by-id (get-attribute topic-elem "id")
:xtm-id xtm-id :revision start-revision)))
(let
((instanceof-topicrefs
@@ -330,17 +321,14 @@
(instance-of
(from-type-elem
(xpath-single-child-elem-by-qname
- role-elem
- *xtm2.0-ns*
- "type") :xtm-id xtm-id))
+ role-elem *xtm2.0-ns* "type")
+ start-revision :xtm-id xtm-id))
(player
- (get-item-by-id
- (get-topicref-uri
- (xpath-single-child-elem-by-qname
- role-elem
- *xtm2.0-ns*
- "topicRef")) :xtm-id xtm-id))
- (reifier-topic (get-reifier-topic role-elem)))
+ (get-item-by-id (get-topicref-uri
+ (xpath-single-child-elem-by-qname
+ role-elem *xtm2.0-ns* "topicRef"))
+ :xtm-id xtm-id :revision start-revision))
+ (reifier-topic (get-reifier-topic role-elem start-revision)))
(unless player ;instance-of will be set later - if there is no one
(error "Role in association with topicref ~a not complete" (get-topicref-uri
(xpath-single-child-elem-by-qname
@@ -369,13 +357,12 @@
(instance-of
(from-type-elem
(xpath-single-child-elem-by-qname
- assoc-elem
- *xtm2.0-ns* "type") :xtm-id xtm-id))
+ assoc-elem *xtm2.0-ns* "type")
+ start-revision :xtm-id xtm-id))
(themes
(from-scope-elem
- (xpath-single-child-elem-by-qname
- assoc-elem
- *xtm2.0-ns* "scope")))
+ (xpath-single-child-elem-by-qname assoc-elem *xtm2.0-ns* "scope")
+ start-revision :xtm-id xtm-id))
(roles ;a list of tuples
(map 'list
(lambda
@@ -384,7 +371,7 @@
(xpath-child-elems-by-qname
assoc-elem
*xtm2.0-ns* "role")))
- (reifier-topic (get-reifier-topic assoc-elem)))
+ (reifier-topic (get-reifier-topic assoc-elem start-revision)))
(setf roles (set-standard-role-types roles)); sets standard role types if there are missing some of them
(add-to-tm
tm
More information about the Isidorus-cvs
mailing list