Author: lgiessmann Date: Wed Nov 25 03:39:26 2009 New Revision: 151 Log: restructured some functions of the importer which are responsible for reifcation; adapted the corresponding unit-tests Modified: trunk/src/model/datamodel.lisp trunk/src/unit_tests/reification_test.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 Wed Nov 25 03:39:26 2009 @@ -1585,40 +1585,30 @@ ;;;;;;;;;;;;;;;;; ;; reification -(defgeneric add-reifier (construct reifier-uri &key xtm-version) - (:method ((construct ReifiableConstructC) reifier-uri &key (xtm-version '2.0)) +(defgeneric add-reifier (construct reifier-topic) + (:method ((construct ReifiableConstructC) reifier-topic) (let ((err "From add-reifier(): ")) - (let ((identifier - (elephant:get-instance-by-value (if (eql xtm-version '1.0) - 'PersistentIdC - 'ItemIdentifierC) 'uri reifier-uri))) - (unless identifier - (when (eql xtm-version '2.0) - (error "~ano identifier could be found with the uri ~a" - err reifier-uri))) - (when identifier - (let ((reifier-topic (identified-construct identifier))) - (unless (typep reifier-topic 'TopicC) - (error "~anidentifier ~a must be bound to a topic, but is ~a" - err reifier-uri (type-of reifier-topic))) - (cond - ((and (not (reifier construct)) - (not (reified reifier-topic))) - (setf (reifier construct) reifier-topic) - (setf (reified reifier-topic) construct)) - ((and (not (reified reifier-topic)) - (reifier construct)) - (merge-reifier-topics (reifier construct) reifier-topic)) - ((and (not (reifier construct)) - (reified reifier-topic)) - (error "~a~a reifies already another object ~a" - err reifier-uri (reified reifier-topic))) - (t - (when (not (eql (reified reifier-topic) construct)) - (error "~a~a reifies already another object ~a" - err reifier-uri (reified reifier-topic))) - (merge-reifier-topics (reifier construct) reifier-topic))))))) - construct)) + (declare (TopicC reifier-topic)) + (cond + ((and (not (reifier construct)) + (not (reified reifier-topic))) + (setf (reifier construct) reifier-topic) + (setf (reified reifier-topic) construct)) + ((and (not (reified reifier-topic)) + (reifier construct)) + (merge-reifier-topics (reifier construct) reifier-topic)) + ((and (not (reifier construct)) + (reified reifier-topic)) + (error "~a~a ~a reifies already another object ~a" + err (psis reifier-topic) (item-identifiers reifier-topic) + (reified reifier-topic))) + (t + (when (not (eql (reified reifier-topic) construct)) + (error "~a~a ~a reifies already another object ~a" + err (psis reifier-topic) (item-identifiers reifier-topic) + (reified reifier-topic))) + (merge-reifier-topics (reifier construct) reifier-topic))) + construct))) (defgeneric merge-reifier-topics (old-topic new-topic) Modified: trunk/src/unit_tests/reification_test.lisp ============================================================================== --- trunk/src/unit_tests/reification_test.lisp (original) +++ trunk/src/unit_tests/reification_test.lisp Wed Nov 25 03:39:26 2009 @@ -353,6 +353,7 @@ ;;TODO: check xtm2.0 exporter ;;TODO: check fragment exporter ;;TODO: check merge-reifier-topics (--> versioning) +;;TODO: extend the fragment-importer in the RESTful-interface (defun run-reification-tests () 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 Wed Nov 25 03:39:26 2009 @@ -18,8 +18,14 @@ (dom:node-value (dom:get-attribute-node reifiable-elem "id"))))) (when (and (stringp reifier-uri) (> (length reifier-uri) 0)) - (add-reifier reifiable-construct (concatenate 'string "#" reifier-uri) :xtm-version '1.0)) - reifiable-construct)) + (let ((psi + (elephant:get-instance-by-value 'd:PersistentIdC 'd:uri + (concatenate 'string "#" reifier-uri)))) + (when psi + (let ((reifier-topic (identified-construct psi))) + (when reifier-topic + (add-reifier reifiable-construct reifier-topic))))))) + reifiable-construct) (defun get-topic-id-xtm1.0 (topic-elem) @@ -408,7 +414,6 @@ (from-member-elem-xtm1.0 member-elem :xtm-id xtm-id)) (xpath-child-elems-by-qname assoc-elem *xtm1.0-ns* "member")))) - ;(format t "type: ~A~%themes: ~A~%roles: ~A~%~%" type themes roles) (unless roles (error "from-association-elem-xtm1.0: roles are missing in association")) (setf roles (set-standard-role-types roles)) @@ -430,7 +435,16 @@ (eql (player assoc-role) (getf list-role :player)) (getf list-role :reifier-uri)) - (add-reifier assoc-role (getf list-role :reifier-uri) :xtm-version '1.0))) + (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)))) 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 Wed Nov 25 03:39:26 2009 @@ -13,11 +13,19 @@ "Sets the reifier-topic of the passed elem to the passed construct." (declare (dom:element reifiable-elem)) (declare (ReifiableConstructC reifiable-construct)) - (let ((reifier-uri (get-attribute reifiable-elem "reifier"))) + (let ((reifier-uri (get-attribute reifiable-elem "reifier")) + (err "From set-reifier(): ")) (when (and (stringp reifier-uri) (> (length reifier-uri) 0)) - (add-reifier reifiable-construct reifier-uri :xtm-version '2.0)) - reifiable-construct)) + (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 reifiable-construct reifier-topic) + (error "~aitem-identifier ~a not found" err reifier-uri))) + (error "~aitem-identifier ~a not found" err reifier-uri))))) + reifiable-construct) (defun from-identifier-elem (classsymbol elem start-revision) @@ -367,7 +375,8 @@ (declare (TopicMapC tm)) (elephant:ensure-transaction (:txn-nosync t) (let - ((item-identifiers + ((err "From from-association-elem(): ") + (item-identifiers (make-identifiers 'ItemIdentifierC assoc-elem "itemIdentity" start-revision)) (instance-of (from-type-elem @@ -403,7 +412,18 @@ (eql (player assoc-role) (getf list-role :player)) (getf list-role :reifier-uri)) - (add-reifier assoc-role (getf list-role :reifier-uri) :xtm-version '2.0))) + (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)))))