Author: lgiessmann Date: Tue Nov 24 10:26:43 2009 New Revision: 148 Log: fixed some problems in the "reification"-functions and added a unit-test for the xtm1.0 importer Modified: trunk/src/isidorus.asd trunk/src/model/datamodel.lisp trunk/src/unit_tests/reification_test.lisp trunk/src/unit_tests/reification_xtm1.0.xtm trunk/src/unit_tests/unittests-constants.lisp trunk/src/xml/xtm/importer_xtm1.0.lisp trunk/src/xml/xtm/importer_xtm2.0.lisp Modified: trunk/src/isidorus.asd ============================================================================== --- trunk/src/isidorus.asd (original) +++ trunk/src/isidorus.asd Tue Nov 24 10:26:43 2009 @@ -111,6 +111,7 @@ (:static-file "poems_light.rdf") (:static-file "poems_light.xtm") (:static-file "full_mapping.rdf") + (:static-file "reification_xtm1.0.xtm") (:file "atom-conf") (:file "unittests-constants" :depends-on ("dangling_topicref.xtm" Modified: trunk/src/model/datamodel.lisp ============================================================================== --- trunk/src/model/datamodel.lisp (original) +++ trunk/src/model/datamodel.lisp Tue Nov 24 10:26:43 2009 @@ -614,12 +614,12 @@ (defgeneric reifier (construct &key revision) (:method ((construct ReifiableConstructC) &key (revision *TM-REVISION*)) (when (slot-boundp construct 'reifier) - (filter-slot-value-by-revision construct 'reifier :start-revision revision)))) + (slot-value construct 'reifier)))) (defgeneric (setf reifier) (topic TopicC) (:method (topic (construct ReifiableConstructC)) - (setf (slot-value construct 'reifier) topic) - (setf (reified topic) construct))) + (setf (slot-value construct 'reifier) topic))) +; (setf (reified topic) construct))) (defgeneric item-identifiers (construct &key revision) (:method ((construct ReifiableConstructC) &key (revision *TM-REVISION*)) @@ -960,12 +960,12 @@ (defgeneric reified (topic &key revision) (:method ((topic TopicC) &key (revision *TM-REVISION*)) (when (slot-boundp topic 'reified) - (filter-slot-value-by-revision topic 'reified :start-revision revision)))) + (slot-value topic 'reified)))) (defgeneric (setf reified) (reifiable ReifiableConstructC) (:method (reifiable (topic TopicC)) - (setf (slot-value topic 'reified) reifiable) - (setf (reifier reifiable) topic))) + (setf (slot-value topic 'reified) reifiable))) +; (setf (reifier reifiable) topic))) (defgeneric occurrences (topic &key revision) (:method ((topic TopicC) &key (revision *TM-REVISION*)) @@ -1585,24 +1585,27 @@ ;;;;;;;;;;;;;;;;; ;; reification -(defgeneric add-reifier (construct reifier-uri reifier-must-exist) - (:method ((construct ReifiableConstructC) reifier-uri reifier-must-exist) +(defgeneric add-reifier (construct reifier-uri &key xtm-version) + (:method ((construct ReifiableConstructC) reifier-uri &key (xtm-version '2.0)) (let ((err "From add-reifier(): ")) - (let ((item-identifier - (elephant:get-instance-by-value 'ItemIdentifierC 'uri reifier-uri))) - (unless item-identifier - (when reifier-must-exist - (error "~ano item-identifier could be found with the uri ~a" + (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 item-identifier - (let ((reifier-topic (identified-construct item-identifier))) + (when identifier + (let ((reifier-topic (identified-construct identifier))) (unless (typep reifier-topic 'TopicC) - (error "~anitem-identifier ~a must be bound to a topic, but is ~a" + (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 (reifier construct) reifier-topic) + (setf (reified reifier-topic) construct)) ((and (not (reified reifier-topic)) (reifier construct)) (merge-reifier-topics (reifier construct) reifier-topic)) Modified: trunk/src/unit_tests/reification_test.lisp ============================================================================== --- trunk/src/unit_tests/reification_test.lisp (original) +++ trunk/src/unit_tests/reification_test.lisp Tue Nov 24 10:26:43 2009 @@ -17,7 +17,8 @@ (:export :reification-test :run-reification-tests - :test-merge-reifier-topics)) + :test-merge-reifier-topics + :test-xtm1.0-reification)) (in-package :reification-test) @@ -209,9 +210,72 @@ (test test-xtm1.0-reification "Tests the reification in the xtm1.0-importer." - - ) - + (let + ((dir "data_base")) + (with-fixture initialize-destination-db (dir) + (xml-importer:import-xtm *reification_xtm1.0.xtm* dir + :tm-id "http://www.isidor.us/unittests/reification-xtm1.0-tests" + :xtm-id "reification-xtm" + :xtm-format '1.0) + (is (= (length (elephant:get-instances-by-class 'TopicC)) 12)) + (is (= (length (elephant:get-instances-by-class 'AssociationC)) 1)) + (let ((homer + (identified-construct + (elephant:get-instance-by-value 'PersistentIdC 'uri "http://simpsons.tv/homer"))) + (married-assoc + (first (elephant:get-instances-by-class 'AssociationC)))) + (let ((homer-occurrence (first (occurrences homer))) + (homer-name (first (names homer))) + (homer-variant (first (variants (first (names homer))))) + (husband-role (find-if #'(lambda(x) + (eql (instance-of x) + (identified-construct + (elephant:get-instance-by-value + 'PersistentIdC 'uri "http://simpsons.tv/husband")))) + (roles married-assoc))) + (reifier-occurrence + (identified-construct (elephant:get-instance-by-value 'PersistentIdC 'uri "#homer-occurrence"))) + (reifier-name + (identified-construct (elephant:get-instance-by-value 'PersistentIdC 'uri "#homer-name"))) + (reifier-variant + (identified-construct (elephant:get-instance-by-value 'PersistentIdC 'uri "#homer-name-variant"))) + (reifier-married-assoc + (identified-construct (elephant:get-instance-by-value 'PersistentIdC 'uri "#a-married"))) + (reifier-husband-role + (identified-construct (elephant:get-instance-by-value 'PersistentIdC 'uri "#married-husband-role")))) + (is-true homer) + (is-true homer-occurrence) + (is-true homer-name) + (is-true homer-variant) + (is-true married-assoc) + (is-true husband-role) + (is-true reifier-occurrence) + (is-true reifier-name) + (is-true reifier-variant) + (is-true reifier-married-assoc) + (is-true reifier-husband-role) + (is (eql (reifier homer-occurrence) reifier-occurrence)) + (is (eql (reified reifier-occurrence) homer-occurrence)) + (is (eql (reifier homer-name) reifier-name)) + (is (eql (reified reifier-name) homer-name)) + (is (eql (reifier homer-variant) reifier-variant)) + (is (eql (reified reifier-variant) homer-variant)) + (is (eql (reifier married-assoc) reifier-married-assoc)) + (is (eql (reified reifier-married-assoc) married-assoc)) + (is (eql (reifier husband-role) reifier-husband-role)) + (is (eql (reified reifier-husband-role) husband-role)) + (is-true (handler-case + (progn (d::delete-construct homer-occurrence) + t) + (condition () nil))) + (is-false (occurrences homer)) + (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 12)) + (is-true (handler-case + (progn (d::delete-construct reifier-occurrence) + t) + (condition () nil))))) + (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 11)) + (elephant:close-store)))) ;;TODO: check xtm2.0 importer @@ -219,8 +283,10 @@ ;;TODO: check xtm1.0 exporter ;;TODO: check xtm2.0 exporter ;;TODO: check fragment exporter +;;TODO: check merge-reifier-topics (--> versioning) (defun run-reification-tests () (it.bese.fiveam:run! 'test-merge-reifier-topics) + (it.bese.fiveam:run! 'test-xtm1.0-refication) ) \ No newline at end of file Modified: trunk/src/unit_tests/reification_xtm1.0.xtm ============================================================================== --- trunk/src/unit_tests/reification_xtm1.0.xtm (original) +++ trunk/src/unit_tests/reification_xtm1.0.xtm Tue Nov 24 10:26:43 2009 @@ -154,7 +154,7 @@ xmlns:xlink="http://www.w3.org/1999/xlink" id="married-husband-reifier"> <t:subjectIdentity> - <t:subjectIndicatorRef xlink:href="#married-husband"/> + <t:subjectIndicatorRef xlink:href="#married-husband-role"/> </t:subjectIdentity> </t:topic> </topicMap> Modified: trunk/src/unit_tests/unittests-constants.lisp ============================================================================== --- trunk/src/unit_tests/unittests-constants.lisp (original) +++ trunk/src/unit_tests/unittests-constants.lisp Tue Nov 24 10:26:43 2009 @@ -31,7 +31,8 @@ :*atom-conf.lisp* :*poems_light.rdf* :*poems_light.xtm* - :*full_mapping.rdf*)) + :*full_mapping.rdf* + :*reification_xtm1.0.xtm*)) (in-package :unittests-constants) @@ -103,4 +104,8 @@ (defparameter *full_mapping.rdf* (asdf:component-pathname - (asdf:find-component *unit-tests-component* "full_mapping.rdf"))) \ No newline at end of file + (asdf:find-component *unit-tests-component* "full_mapping.rdf"))) + +(defparameter *reification_xtm1.0.xtm* + (asdf:component-pathname + (asdf:find-component *unit-tests-component* "reification_xtm1.0.xtm"))) \ No newline at end of file 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 Tue Nov 24 10:26:43 2009 @@ -18,7 +18,7 @@ (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) nil)) + (add-reifier reifiable-construct (concatenate 'string "#" reifier-uri) :xtm-version '1.0)) reifiable-construct)) @@ -430,9 +430,10 @@ (eql (player assoc-role) (getf list-role :player)) (getf list-role :reifier-uri)) - (add-reifier assoc-role (getf list-role :reifier-uri) nil))) + (add-reifier assoc-role (getf list-role :reifier-uri) :xtm-version '1.0))) roles)) - (roles association)))))) + (roles association)) + association)))) (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 Tue Nov 24 10:26:43 2009 @@ -16,7 +16,7 @@ (let ((reifier-uri (get-attribute reifiable-elem "reifier"))) (when (and (stringp reifier-uri) (> (length reifier-uri) 0)) - (add-reifier reifiable-construct reifier-uri t)) + (add-reifier reifiable-construct reifier-uri :xtm-version '2.0)) reifiable-construct)) @@ -403,7 +403,7 @@ (eql (player assoc-role) (getf list-role :player)) (getf list-role :reifier-uri)) - (add-reifier assoc-role (getf list-role :reifier-uri) t))) + (add-reifier assoc-role (getf list-role :reifier-uri) :xtm-version '2.0))) roles)) (roles assoc)) (set-reifier assoc-elem assoc)))))