isidorus-cvs June 2010

isidorus-cvs@common-lisp.net

1 participants
11 discussions

[isidorus-cvs] r296 - in branches/new-datamodel/src: model unit_tests xml/xtm
by Lukas Giessmann 09 Jun '10

09 Jun '10

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

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

isidorus-cvs June 2010