Author: lgiessmann Date: Fri Dec 11 19:29:01 2009 New Revision: 172

Log: added some more beauty to the xtm-importers in the reification-sections :-)

Modified: trunk/src/model/datamodel.lisp trunk/src/xml/rdf/importer.lisp trunk/src/xml/xtm/importer_xtm1.0.lisp trunk/src/xml/xtm/importer_xtm2.0.lisp

Modified: trunk/src/model/datamodel.lisp ============================================================================== --- trunk/src/model/datamodel.lisp (original) +++ trunk/src/model/datamodel.lisp Fri Dec 11 19:29:01 2009 @@ -1450,12 +1450,13 @@ (declare (list roles)) (let ((association (call-next-method))) - (dolist (role-tuple roles) + (dolist (role-data roles) (make-instance 'RoleC - :instance-of (getf role-tuple :instance-of) - :player (getf role-tuple :player) - :item-identifiers (getf role-tuple :item-identifiers) + :instance-of (getf role-data :instance-of) + :player (getf role-data :player) + :item-identifiers (getf role-data :item-identifiers) + :reifier (getf role-data :reifier) :parent association))))

(defmethod make-construct :around ((class-symbol (eql 'AssociationC))

Modified: trunk/src/xml/rdf/importer.lisp ============================================================================== --- trunk/src/xml/rdf/importer.lisp (original) +++ trunk/src/xml/rdf/importer.lisp Fri Dec 11 19:29:01 2009 @@ -354,10 +354,6 @@ :player super-top) (list :instance-of role-type-2 :player sub-top)))) - ;(when reifier-id - ;(make-reification reifier-id sub-top super-top - ; assoc-type start-revision tm - ; :document-id document-id)) (let ((assoc (add-to-topicmap tm @@ -399,10 +395,6 @@ :player type-top) (list :instance-of roletype-2 :player instance-top)))) - ;(when reifier-id - ; (make-reification reifier-id instance-top type-top - ; assoc-type start-revision tm - ; :document-id document-id)) (let ((assoc (add-to-topicmap tm @@ -509,9 +501,6 @@ :player player-1) (list :instance-of role-type-2 :player top)))) - ;(when ID - ; (make-reification ID top player-1 type-top start-revision - ; tm :document-id document-id)) (let ((assoc (add-to-topicmap tm (make-construct 'AssociationC :start-revision start-revision @@ -560,44 +549,6 @@ :document-id document-id))) (add-reifier reifiable-construct reifier-topic)))

-;(defun make-reification (reifier-id subject object predicate start-revision tm -; &key document-id) -; "Creates a reification construct." -; (declare (string reifier-id)) -; (declare ((or OccurrenceC TopicC) object)) -; (declare (TopicC subject predicate)) -; (declare (TopicMapC tm)) -; (elephant:ensure-transaction (:txn-nosync t) -; (let ((reifier (make-topic-stub reifier-id nil nil nil start-revision tm -; :document-id document-id)) -; (predicate-arc (make-topic-stub *rdf-predicate* nil nil nil -; start-revision -; tm :document-id document-id)) -; (object-arc (make-topic-stub *rdf-object* nil nil nil start-revision -; tm :document-id document-id)) -; (subject-arc (make-topic-stub *rdf-subject* nil nil nil -; start-revision -; tm :document-id document-id)) -; (statement (make-topic-stub *rdf-statement* nil nil nil start-revision -; tm :document-id document-id))) -; (make-instance-of-association reifier statement nil start-revision tm -; :document-id document-id) -; (make-association-with-nodes reifier subject subject-arc tm -; start-revision :document-id document-id) -; (make-association-with-nodes reifier predicate predicate-arc -; tm start-revision :document-id document-id) -; (if (typep object 'd:TopicC) -; (make-association-with-nodes reifier object object-arc -; tm start-revision -; :document-id document-id) -; (make-construct 'd:OccurrenceC -; :start-revision start-revision -; :topic reifier -; :themes (themes object) -; :instance-of (instance-of object) -; :charvalue (charvalue object) -; :datatype (datatype object)))))) -

(defun make-occurrence (top literal start-revision tm-id &key (document-id *document-id*)) @@ -628,8 +579,6 @@ :charvalue value :datatype datatype))) (when ID - ;(make-reification ID top occurrence type-top start-revision - ; xml-importer::tm :document-id document-id)) (make-reification ID occurrence start-revision xml-importer::tm :document-id document-id)) occurrence))))))

Modified: trunk/src/xml/xtm/importer_xtm1.0.lisp ============================================================================== --- trunk/src/xml/xtm/importer_xtm1.0.lisp (original) +++ trunk/src/xml/xtm/importer_xtm1.0.lisp Fri Dec 11 19:29:01 2009 @@ -9,10 +9,9 @@

(in-package :xml-importer)

-(defun set-reifier-xtm1.0 (reifiable-elem reifiable-construct) - "Sets the reifier-topic of the passed elem to the passed construct." +(defun get-reifier-topic-xtm1.0 (reifiable-elem) + "Returns a reifier topic of the reifiable-element or nil." (declare (dom:element reifiable-elem)) - (declare (ReifiableConstructC reifiable-construct)) (let ((reifier-uri (when (dom:get-attribute-node reifiable-elem "id") (dom:node-value (dom:get-attribute-node reifiable-elem "id"))))) @@ -24,8 +23,7 @@ (when psi (let ((reifier-topic (identified-construct psi))) (when reifier-topic - (add-reifier reifiable-construct reifier-topic))))))) - reifiable-construct) + reifier-topic)))))))

(defun get-topic-id-xtm1.0 (topic-elem) @@ -87,7 +85,8 @@ ((typep parent-construct 'VariantC) (name parent-construct)) (t - (error "from-variant-elem-xtm1.0: parent-cosntruct is neither NameC nor VariantC"))))) + (error "from-variant-elem-xtm1.0: parent-construct is neither NameC nor VariantC")))) + (reifier-topic (get-reifier-topic-xtm1.0 variant-elem))) (unless (and variantName parameters) (error "from-variant-elem-xtm1.0: parameters and variantName must be set")) (let ((variant (make-construct 'VariantC @@ -95,8 +94,8 @@ :themes parameters :charvalue (getf variantName :data) :datatype (getf variantName :type) + :reifier reifier-topic :name parent-name))) - (set-reifier-xtm1.0 variant-elem variant) (let ((inner-variants (map 'list #'(lambda(x) (from-variant-elem-xtm1.0 x variant start-revision :xtm-id xtm-id)) @@ -149,7 +148,8 @@ (xpath-single-child-elem-by-qname baseName-elem *xtm1.0-ns* "scope") :xtm-id xtm-id))) (baseNameString (xpath-fn-string - (xpath-single-child-elem-by-qname baseName-elem *xtm1.0-ns* "baseNameString")))) + (xpath-single-child-elem-by-qname baseName-elem *xtm1.0-ns* "baseNameString"))) + (reifier-topic (get-reifier-topic-xtm1.0 baseName-elem))) (unless baseNameString (error "A baseName must have exactly one baseNameString"))

@@ -157,8 +157,8 @@ :start-revision start-revision :topic top :charvalue baseNameString + :reifier reifier-topic :themes themes))) - (set-reifier-xtm1.0 baseName-elem name) (map 'list #'(lambda(x) (from-variant-elem-xtm1.0 x name start-revision :xtm-id xtm-id)) (xpath-child-elems-by-qname baseName-elem *xtm1.0-ns* "variant")) @@ -262,21 +262,22 @@ (themes (from-scope-elem-xtm1.0 (xpath-single-child-elem-by-qname occ-elem *xtm1.0-ns* "scope") :xtm-id xtm-id)) - (occurrence-value - (from-resourceX-elem-xtm1.0 occ-elem))) + (occurrence-value + (from-resourceX-elem-xtm1.0 occ-elem)) + (reifier-topic (get-reifier-topic-xtm1.0 occ-elem))) (unless occurrence-value (error "from-occurrence-elem-xtm1.0: one of resourceRef and resourceData must be set")) (unless instanceOf (format t "from-occurrence-elem-xtm1.0: type is missing -> http://psi.topicmaps.org/iso13250/model/type-instance~%") (setf instanceOf (get-item-by-id "type-instance" :xtm-id "core.xtm"))) - (let ((occurrence (make-construct 'OccurrenceC - :start-revision start-revision - :topic top - :themes themes - :instance-of instanceOf - :charvalue (getf occurrence-value :data) - :datatype (getf occurrence-value :type)))) - (set-reifier-xtm1.0 occ-elem occurrence)))) + (make-construct 'OccurrenceC + :start-revision start-revision + :topic top + :themes themes + :instance-of instanceOf + :charvalue (getf occurrence-value :data) + :reifier reifier-topic + :datatype (getf occurrence-value :type))))

(defun from-subjectIdentity-elem-xtm1.0 (subjectIdentity-elem start-revision) @@ -331,16 +332,14 @@ member-elem *xtm1.0-ns* "subjectIndicatorRef"))))))) - (reifier-uri - (when (dom:get-attribute-node member-elem "id") - (concatenate 'string "#" (dom:node-value (dom:get-attribute-node member-elem "id")))))) + (reifier-topic (get-reifier-topic-xtm1.0 member-elem))) (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")) (list :instance-of type :player (first player) :item-identifiers nil - :reifier-uri reifier-uri))))) + :reifier reifier-topic)))))

(defun from-topic-elem-to-stub-xtm1.0 (topic-elem start-revision @@ -413,41 +412,22 @@ #'(lambda(member-elem) (from-member-elem-xtm1.0 member-elem :xtm-id xtm-id)) - (xpath-child-elems-by-qname assoc-elem *xtm1.0-ns* "member")))) + (xpath-child-elems-by-qname assoc-elem *xtm1.0-ns* "member"))) + (reifier-topic (get-reifier-topic-xtm1.0 assoc-elem))) (unless roles (error "from-association-elem-xtm1.0: roles are missing in association")) (setf roles (set-standard-role-types roles)) (unless type (format t "from-association-elem-xtm1.0: type is missing -> http://www.topicmaps.org/xtm/1.0/core.xtm#association~%") (setf type (get-item-by-id "association" :xtm-id "core.xtm"))) - (let - ((association (make-construct 'AssociationC - :start-revision start-revision - :instance-of type - :themes themes - :roles roles))) - (add-to-topicmap tm association) - (set-reifier-xtm1.0 assoc-elem association) - (map 'list #'(lambda(assoc-role) - (map 'list #'(lambda(list-role) - (when (and (eql (instance-of assoc-role) - (getf list-role :instance-of)) - (eql (player assoc-role) - (getf list-role :player)) - (getf list-role :reifier-uri)) - (let ((reifier-uri (getf list-role :reifier-uri))) - (when (and (stringp reifier-uri) - (> (length reifier-uri) 0)) - (let ((psi - (elephant:get-instance-by-value 'd:PersistentIdC 'd:uri - reifier-uri))) - (when psi - (let ((reifier-topic (identified-construct psi))) - (when reifier-topic - (add-reifier assoc-role reifier-topic))))))))) - roles)) - (roles association)) - association)))) + (add-to-topicmap tm + (make-construct 'AssociationC + :start-revision start-revision + :instance-of type + :themes themes + :reifier reifier-topic + :roles roles))))) +

(defun set-standard-role-types (roles)

Modified: trunk/src/xml/xtm/importer_xtm2.0.lisp ============================================================================== --- trunk/src/xml/xtm/importer_xtm2.0.lisp (original) +++ trunk/src/xml/xtm/importer_xtm2.0.lisp Fri Dec 11 19:29:01 2009 @@ -9,12 +9,11 @@

(in-package :xml-importer)

-(defun set-reifier (reifiable-elem reifiable-construct) - "Sets the reifier-topic of the passed elem to the passed construct." +(defun get-reifier-topic(reifiable-elem) + "Returns the reifier topic of the reifierable-element or nil." (declare (dom:element reifiable-elem)) - (declare (ReifiableConstructC reifiable-construct)) (let ((reifier-uri (get-attribute reifiable-elem "reifier")) - (err "From set-reifier(): ")) + (err "From get-reifier-topic(): ")) (when (and (stringp reifier-uri) (> (length reifier-uri) 0)) (let ((ii @@ -22,10 +21,9 @@ (if ii (let ((reifier-topic (identified-construct ii))) (if reifier-topic - (add-reifier reifiable-construct reifier-topic) + reifier-topic (error "~aitem-identifier ~a not found" err reifier-uri))) - (error "~aitem-identifier ~a not found" err reifier-uri))))) - reifiable-construct) + (error "~aitem-identifier ~a not found" err reifier-uri))))))

(defun from-identifier-elem (classsymbol elem start-revision) @@ -35,15 +33,10 @@ (declare (symbol classsymbol)) (declare (dom:element elem)) (declare (integer start-revision)) - -;; (make-construct classsymbol -;; :uri (get-attribute elem "href") -;; :start-revision start-revision)) (let ((id (make-instance classsymbol :uri (get-attribute elem "href") :start-revision start-revision))) - ;(add-to-version-history id :start-revision start-revision) id))

@@ -133,7 +126,8 @@ (instance-of (from-type-elem (xpath-single-child-elem-by-qname name-elem - *xtm2.0-ns* "type") :xtm-id xtm-id))) + *xtm2.0-ns* "type") :xtm-id xtm-id)) + (reifier-topic (get-reifier-topic name-elem))) (unless namevalue (error "A name must have exactly one namevalue"))

@@ -143,10 +137,11 @@ :charvalue namevalue :instance-of instance-of :item-identifiers item-identifiers + :reifier reifier-topic :themes themes))) (loop for variant-elem across (xpath-child-elems-by-qname name-elem *xtm2.0-ns* "variant") do (from-variant-elem variant-elem name start-revision :xtm-id xtm-id)) - (set-reifier name-elem name)))) + name)))

(defun from-resourceX-elem (parent-elem) @@ -195,18 +190,19 @@ (themes (append (from-scope-elem (xpath-single-child-elem-by-qname variant-elem *xtm2.0-ns* "scope") :xtm-id xtm-id) (themes name))) - (variant-value (from-resourceX-elem variant-elem))) + (variant-value (from-resourceX-elem variant-elem)) + (reifier-topic (get-reifier-topic variant-elem))) (unless variant-value (error "VariantC: one of resourceRef and resourceData must be set"))

- (let ((variant (make-construct 'VariantC - :start-revision start-revision - :item-identifiers item-identifiers - :themes themes - :charvalue (getf variant-value :data) - :datatype (getf variant-value :type) - :name name))) - (set-reifier variant-elem variant)))) + (make-construct 'VariantC + :start-revision start-revision + :item-identifiers item-identifiers + :themes themes + :charvalue (getf variant-value :data) + :datatype (getf variant-value :type) + :reifier reifier-topic + :name name)))

(defun from-occurrence-elem (occ-elem top start-revision &key (xtm-id *current-xtm*)) @@ -228,18 +224,19 @@ (from-type-elem (xpath-single-child-elem-by-qname occ-elem *xtm2.0-ns* "type") :xtm-id xtm-id)) - (occurrence-value (from-resourceX-elem occ-elem))) + (occurrence-value (from-resourceX-elem occ-elem)) + (reifier-topic (get-reifier-topic occ-elem))) (unless occurrence-value (error "OccurrenceC: one of resourceRef and resourceData must be set")) - (let ((occurrence (make-construct 'OccurrenceC - :start-revision start-revision - :topic top - :themes themes - :item-identifiers item-identifiers - :instance-of instance-of - :charvalue (getf occurrence-value :data) - :datatype (getf occurrence-value :type)))) - (set-reifier occ-elem occurrence)))) + (make-construct 'OccurrenceC + :start-revision start-revision + :topic top + :themes themes + :item-identifiers item-identifiers + :instance-of instance-of + :charvalue (getf occurrence-value :data) + :reifier reifier-topic + :datatype (getf occurrence-value :type))))

@@ -344,21 +341,14 @@ role-elem *xtm2.0-ns* "topicRef")) :xtm-id xtm-id)) - (reifier-uri - (let ((value (get-attribute role-elem "reifier"))) - (if (and (stringp value) - (> (length value) 0)) - value - nil)))) -; (unless (and player instance-of) -; (error "Role in association not complete")) + (reifier-topic (get-reifier-topic role-elem))) (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 role-elem *xtm2.0-ns* "topicRef")))) - (list :reifier-uri reifier-uri + (list :reifier reifier-topic :instance-of instance-of :player player :item-identifiers item-identifiers)))) @@ -375,8 +365,7 @@ (declare (TopicMapC tm)) (elephant:ensure-transaction (:txn-nosync t) (let - ((err "From from-association-elem(): ") - (item-identifiers + ((item-identifiers (make-identifiers 'ItemIdentifierC assoc-elem "itemIdentity" start-revision)) (instance-of (from-type-elem @@ -395,40 +384,18 @@ (from-role-elem role-elem start-revision :xtm-id xtm-id)) (xpath-child-elems-by-qname assoc-elem - *xtm2.0-ns* "role")))) + *xtm2.0-ns* "role"))) + (reifier-topic (get-reifier-topic assoc-elem))) (setf roles (set-standard-role-types roles)); sets standard role types if there are missing some of them - (let ((assoc (add-to-topicmap - tm - (make-construct 'AssociationC - :start-revision start-revision - :item-identifiers item-identifiers - :instance-of instance-of - :themes themes - :roles roles)))) - (map 'list #'(lambda(assoc-role) - (map 'list #'(lambda(list-role) - (when (and (eql (instance-of assoc-role) - (getf list-role :instance-of)) - (eql (player assoc-role) - (getf list-role :player)) - (getf list-role :reifier-uri)) - (let ((reifier-uri (getf list-role :reifier-uri))) - (when (and (stringp reifier-uri) - (> (length reifier-uri) 0)) - (let ((ii - (elephant:get-instance-by-value 'd:ItemIdentifierC 'd:uri - reifier-uri))) - (if ii - (let ((reifier-topic (identified-construct ii))) - (if reifier-topic - (add-reifier assoc-role reifier-topic) - (error "~aitem-identifier ~a not found" err reifier-uri))) - (error "~aitem-identifier ~a not found" err reifier-uri))))))) - roles)) - (roles assoc)) - (set-reifier assoc-elem assoc))))) - - + (add-to-topicmap + tm + (make-construct 'AssociationC + :start-revision start-revision + :item-identifiers item-identifiers + :instance-of instance-of + :themes themes + :reifier reifier-topic + :roles roles)))))

(defun get-topic-elems (xtm-dom) (xpath-child-elems-by-qname xtm-dom