November 2009 - isidorus-cvs@common-lisp.net

[isidorus-cvs] r154 - in trunk/src: unit_tests xml/rdf
by Lukas Giessmann 26 Nov '09

26 Nov '09

Author: lgiessmann Date: Thu Nov 26 05:40:44 2009 New Revision: 154 Log: changed the reification handling in the rdf-importer, so all reifiable-constructs are reified by other resources by the reifier-slot --> added some unit-tests Modified: trunk/src/unit_tests/rdf_importer_test.lisp trunk/src/unit_tests/reification_test.lisp trunk/src/xml/rdf/importer.lisp Modified: trunk/src/unit_tests/rdf_importer_test.lisp ============================================================================== --- trunk/src/unit_tests/rdf_importer_test.lisp (original) +++ trunk/src/unit_tests/rdf_importer_test.lisp Thu Nov 26 05:40:44 2009 @@ -58,7 +58,6 @@ :test-get-associations-of-node-content :test-parse-properties-of-node :test-import-node-1 - :test-import-node-reification :test-import-dom :test-poems-rdf-occurrences :test-poems-rdf-associations @@ -1218,236 +1217,6 @@ (is-false (d:psis (d:player object-role)))))))))))) (elephant:close-store)) - -(test test-import-node-reification - "Tests the function import-node non-recursively. Especially the reification - of association- and occurrence-arcs." - (let ((db-dir "data_base") - (tm-id "http://test-tm/") - (revision-1 100) - (document-id "doc-id") - (doc-1 - (concatenate 'string "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" " - "xmlns:arcs=\"http://test/arcs/\" " - "xmlns:rdfs=\"" *rdfs-ns* "\">" - "<rdf:Description rdf:about=\"first-node\">" - "<arcs:arc1 rdf:ID=\"reification-1\">" - "<rdf:Description rdf:about=\"second-node\" />" - "</arcs:arc1>" - "</rdf:Description>" - "<rdf:Description rdf:ID=\"#reification-1\">" - "<arcs:arc2 rdf:resource=\"third-node\"/>" - "</rdf:Description>" - "<rdf:Description rdf:nodeID=\"fourth-node\">" - "<arcs:arc3 rdf:ID=\"reification-2\" rdf:datatype=\"dt\">" - "occurrence data" - "</arcs:arc3>" - "</rdf:Description>" - "<rdf:Description rdf:ID=\"#reification-2\">" - "<arcs:arc4 rdf:resource=\"fifth-node\" />" - "</rdf:Description>" - "</rdf:RDF>"))) - (let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder)))) - (is-true dom-1) - (is (= (length (dom:child-nodes dom-1)) 1)) - (let ((rdf-node (elt (dom:child-nodes dom-1) 0))) - (is (= (length (dom:child-nodes rdf-node)) 4)) - (rdf-init-db :db-dir db-dir :start-revision revision-1) - (dotimes (iter (length (dom:child-nodes rdf-node))) - (rdf-importer::import-node (elt (dom:child-nodes rdf-node) iter) - tm-id revision-1 - :document-id document-id)) - (let ((reification-1 (d:get-item-by-id "http://test-tm#reification-1" - :xtm-id document-id)) - (reification-2 (d:get-item-by-id "http://test-tm#reification-2" - :xtm-id document-id)) - (first-node (d:get-item-by-id "http://test-tm/first-node" - :xtm-id document-id)) - (second-node (d:get-item-by-id "http://test-tm/second-node" - :xtm-id document-id)) - (third-node (d:get-item-by-id "http://test-tm/third-node" - :xtm-id document-id)) - (fourth-node (d:get-item-by-id "fourth-node" - :xtm-id document-id)) - (fifth-node (d:get-item-by-id "http://test-tm/fifth-node" - :xtm-id document-id)) - (arc1 (d:get-item-by-id "http://test/arcs/arc1" - :xtm-id document-id)) - (arc2 (d:get-item-by-id "http://test/arcs/arc2" - :xtm-id document-id)) - (arc3 (d:get-item-by-id "http://test/arcs/arc3" - :xtm-id document-id)) - (arc4 (d:get-item-by-id "http://test/arcs/arc4" - :xtm-id document-id)) - (statement (d:get-item-by-psi *rdf-statement*)) - (object (d:get-item-by-psi *rdf-object*)) - (subject (d:get-item-by-psi *rdf-subject*)) - (predicate (d:get-item-by-psi *rdf-predicate*)) - (type (d:get-item-by-psi *type-psi*)) - (instance (d:get-item-by-psi *instance-psi*)) - (type-instance (d:get-item-by-psi *type-instance-psi*)) - (isi-subject (d:get-item-by-psi *rdf2tm-subject*)) - (isi-object (d:get-item-by-psi *rdf2tm-object*))) - (is (= (length (d:psis reification-1)) 1)) - (is (string= (d:uri (first (d:psis reification-1))) - "http://test-tm#reification-1")) - (is (= (length (d:psis reification-2)) 1)) - (is (string= (d:uri (first (d:psis reification-2))) - "http://test-tm#reification-2")) - (is (= (length (d:psis first-node)) 1)) - (is (string= (d:uri (first (d:psis first-node))) - "http://test-tm/first-node")) - (is (= (length (d:psis second-node)) 1)) - (is (string= (d:uri (first (d:psis second-node))) - "http://test-tm/second-node")) - (is (= (length (d:psis third-node)) 1)) - (is (string= (d:uri (first (d:psis third-node))) - "http://test-tm/third-node")) - (is (= (length (d:psis fourth-node)) 0)) - (is (= (length (d:psis fifth-node)) 1)) - (is (string= (d:uri (first (d:psis fifth-node))) - "http://test-tm/fifth-node")) - (is (= (length (d:psis arc1)) 1)) - (is (string= (d:uri (first (d:psis arc1))) - "http://test/arcs/arc1")) - (is (= (length (d:psis arc2)))) - (is (string= (d:uri (first (d:psis arc2))) - "http://test/arcs/arc2")) - (is (= (length (d:psis arc3)))) - (is (string= (d:uri (first (d:psis arc3))) - "http://test/arcs/arc3")) - (is (= (length (d:psis arc4)))) - (is (string= (d:uri (first (d:psis arc4))) - "http://test/arcs/arc4")) - (is-true statement) - (is-true object) - (is-true subject) - (is-true predicate) - (is-true type) - (is-true instance) - (is-true type-instance) - (is (= (length (d:player-in-roles first-node)) 2)) - (is-true (find-if #'(lambda(x) - (and (eql (d:instance-of x) isi-subject) - (eql (d:instance-of (d:parent x)) arc1))) - (d:player-in-roles first-node))) - (is-true (find-if #'(lambda(x) - (and (eql (d:instance-of x) isi-object) - (eql (d:instance-of (d:parent x)) - subject))) - (d:player-in-roles first-node))) - (is (= (length (d:player-in-roles second-node)) 2)) - (is-true (find-if #'(lambda(x) - (and (eql (d:instance-of x) isi-object) - (eql (d:instance-of (d:parent x)) arc1))) - (d:player-in-roles second-node))) - (is-true (find-if #'(lambda(x) - (and (eql (d:instance-of x) isi-object) - (eql (d:instance-of (d:parent x)) - object))) - (d:player-in-roles second-node))) - (is (= (length (d:player-in-roles statement)) 2)) - (is-true (find-if #'(lambda(x) - (and (eql (d:instance-of x) type) - (eql (d:instance-of (d:parent x)) - type-instance))) - (d:player-in-roles statement))) - (is (= (length (d:player-in-roles arc1)) 1)) - (is-true (find-if #'(lambda(x) - (and (eql (d:instance-of x) isi-object) - (eql (d:instance-of (d:parent x)) - predicate))) - (d:player-in-roles arc1))) - (is (= (length (d:player-in-roles third-node)) 1)) - (is-true (find-if #'(lambda(x) - (and (eql (d:instance-of x) isi-object) - (eql (d:instance-of (d:parent x)) - arc2))) - (d:player-in-roles third-node))) - (is (= (length (d:player-in-roles reification-1)) 5)) - (is-true (find-if #'(lambda(x) - (and (eql (d:instance-of x) isi-subject) - (eql (d:instance-of (d:parent x)) - subject))) - (d:player-in-roles reification-1))) - (is-true (find-if #'(lambda(x) - (and (eql (d:instance-of x) isi-subject) - (eql (d:instance-of (d:parent x)) - object))) - (d:player-in-roles reification-1))) - (is-true (find-if #'(lambda(x) - (and (eql (d:instance-of x) instance) - (eql (d:instance-of (d:parent x)) - type-instance))) - (d:player-in-roles reification-1))) - (is-true (find-if #'(lambda(x) - (and (eql (d:instance-of x) isi-subject) - (eql (d:instance-of (d:parent x)) - object))) - (d:player-in-roles reification-1))) - (is-true (find-if #'(lambda(x) - (and (eql (d:instance-of x) isi-subject) - (eql (d:instance-of (d:parent x)) - predicate))) - (d:player-in-roles reification-1))) - (is-true (find-if #'(lambda(x) - (and (eql (d:instance-of x) isi-subject) - (eql (d:instance-of (d:parent x)) - arc2))) - (d:player-in-roles reification-1))) - (is (= (length (d:occurrences fourth-node)) 1)) - (is (string= (d:charvalue (first (d:occurrences fourth-node))) - "occurrence data")) - (is (string= (d:datatype (first (d:occurrences fourth-node))) - "http://test-tm/dt")) - (is (eql (d:instance-of (first (d:occurrences fourth-node))) - arc3)) - (is (= (length (d:player-in-roles fourth-node)) 1)) - (is-true (find-if #'(lambda(x) - (and (eql (d:instance-of x) isi-object) - (eql (d:instance-of (d:parent x)) - subject))) - (d:player-in-roles fourth-node))) - (is (= (length (d:player-in-roles arc3)) 1)) - (is-true (find-if #'(lambda(x) - (and (eql (d:instance-of x) isi-object) - (eql (d:instance-of (d:parent x)) - predicate))) - (d:player-in-roles arc3))) - (is (= (length (d:player-in-roles fifth-node)) 1)) - (is-true (find-if #'(lambda(x) - (and (eql (d:instance-of x) isi-object) - (eql (d:instance-of (d:parent x)) - arc4))) - (d:player-in-roles fifth-node))) - (is (= (length (d:occurrences reification-2)) 1)) - (is (string= (d:charvalue (first (d:occurrences reification-2))) - "occurrence data")) - (is (string= (d:datatype (first (d:occurrences reification-2))) - "http://test-tm/dt")) - (is (= (length (d:player-in-roles reification-2)) 4)) - (is-true (find-if #'(lambda(x) - (and (eql (d:instance-of x) isi-subject) - (eql (d:instance-of (d:parent x)) - subject))) - (d:player-in-roles reification-2))) - (is-true (find-if #'(lambda(x) - (and (eql (d:instance-of x) isi-subject) - (eql (d:instance-of (d:parent x)) - predicate))) - (d:player-in-roles reification-2))) - (is-true (find-if #'(lambda(x) - (and (eql (d:instance-of x) isi-subject) - (eql (d:instance-of (d:parent x)) - arc4))) - (d:player-in-roles reification-2))) - (is-true (find-if #'(lambda(x) - (and (eql (d:instance-of x) instance) - (eql (d:instance-of (d:parent x)) - type-instance))) - (d:player-in-roles reification-2))) - (elephant:close-store)))))) - (test test-import-dom "Tests the function import-node when used recursively." @@ -3385,7 +3154,6 @@ (it.bese.fiveam:run! 'test-get-associations-of-node-content) (it.bese.fiveam:run! 'test-parse-properties-of-node) (it.bese.fiveam:run! 'test-import-node-1) - (it.bese.fiveam:run! 'test-import-node-reification) (it.bese.fiveam:run! 'test-import-dom) (it.bese.fiveam:run! 'test-poems-rdf-occurrences) (it.bese.fiveam:run! 'test-poems-rdf-associations) Modified: trunk/src/unit_tests/reification_test.lisp ============================================================================== --- trunk/src/unit_tests/reification_test.lisp (original) +++ trunk/src/unit_tests/reification_test.lisp Thu Nov 26 05:40:44 2009 @@ -18,7 +18,14 @@ (:import-from :constants *xtm2.0-ns* *xtm1.0-ns* - *xtm1.0-xlink*) + *xtm1.0-xlink* + *rdf-ns* + *rdfs-ns* + *type-psi* + *instance-psi* + *type-instance-psi* + *rdf2tm-subject* + *rdf2tm-object*) (:import-from :xml-tools xpath-child-elems-by-qname xpath-single-child-elem-by-qname xpath-fn-string) @@ -29,7 +36,8 @@ :test-xtm1.0-reification :test-xtm2.0-reification :test-xtm1.0-reification-exporter - :test-xtm2.0-reification-exporter)) + :test-xtm2.0-reification-exporter + :test-rdf-importer-reification)) (in-package :reification-test) @@ -448,6 +456,7 @@ (error () )) ;do nothing (elephant:close-store)))) + (test test-xtm2.0-reification-exporter "Tests the reification in the xtm2.0-exporter." (let @@ -510,12 +519,119 @@ return t) return t))))) (elephant:close-store))) - + + +(test test-rdf-importer-reification + "Tests the function import-node non-recursively. Especially the reification + of association- and occurrence-arcs." + (let ((db-dir "data_base") + (tm-id "http://test-tm/") + (revision-1 100) + (document-id "doc-id") + (doc-1 + (concatenate 'string "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" " + "xmlns:arcs=\"http://test/arcs/\" " + "xmlns:rdfs=\"" *rdfs-ns* "\">" + "<rdf:Description rdf:about=\"first-node\">" + "<arcs:arc1 rdf:ID=\"reification-1\">" + "<rdf:Description rdf:about=\"second-node\" />" + "</arcs:arc1>" + "</rdf:Description>" + "<rdf:Description rdf:ID=\"#reification-1\">" + "<arcs:arc2 rdf:resource=\"third-node\"/>" + "</rdf:Description>" + "<rdf:Description rdf:nodeID=\"fourth-node\">" + "<arcs:arc3 rdf:ID=\"reification-2\" rdf:datatype=\"dt\">" + "occurrence data" + "</arcs:arc3>" + "</rdf:Description>" + "<rdf:Description rdf:ID=\"#reification-2\">" + "<arcs:arc4 rdf:resource=\"fifth-node\" />" + "</rdf:Description>" + "</rdf:RDF>"))) + (let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder)))) + (is-true dom-1) + (is (= (length (dom:child-nodes dom-1)) 1)) + (let ((rdf-node (elt (dom:child-nodes dom-1) 0))) + (is (= (length (dom:child-nodes rdf-node)) 4)) + (rdf-init-db :db-dir db-dir :start-revision revision-1) + (dotimes (iter (length (dom:child-nodes rdf-node))) + (rdf-importer::import-node (elt (dom:child-nodes rdf-node) iter) + tm-id revision-1 + :document-id document-id)) + (is (= (length (dom:child-nodes rdf-node)) 4)) + (rdf-init-db :db-dir db-dir :start-revision revision-1) + (dotimes (iter (length (dom:child-nodes rdf-node))) + (rdf-importer::import-node (elt (dom:child-nodes rdf-node) iter) + tm-id revision-1 + :document-id document-id)) + (let ((reification-1 (d:get-item-by-id "http://test-tm#reification-1" + :xtm-id document-id)) + (reification-2 (d:get-item-by-id "http://test-tm#reification-2" + :xtm-id document-id)) + (first-node (d:get-item-by-id "http://test-tm/first-node" + :xtm-id document-id)) + (second-node (d:get-item-by-id "http://test-tm/second-node" + :xtm-id document-id)) + (third-node (d:get-item-by-id "http://test-tm/third-node" + :xtm-id document-id)) + (fourth-node (d:get-item-by-id "fourth-node" + :xtm-id document-id)) + (fifth-node (d:get-item-by-id "http://test-tm/fifth-node" + :xtm-id document-id)) + (arc1 (d:get-item-by-id "http://test/arcs/arc1" + :xtm-id document-id)) + (arc2 (d:get-item-by-id "http://test/arcs/arc2" + :xtm-id document-id)) + (arc3 (d:get-item-by-id "http://test/arcs/arc3" + :xtm-id document-id)) + (arc4 (d:get-item-by-id "http://test/arcs/arc4" + :xtm-id document-id))) + (is (= (length (d:psis reification-1)) 1)) + (is (string= (d:uri (first (d:psis reification-1))) + "http://test-tm#reification-1")) + (is (= (length (d:psis reification-2)) 1)) + (is (string= (d:uri (first (d:psis reification-2))) + "http://test-tm#reification-2")) + (is (= (length (d:psis first-node)) 1)) + (is (string= (d:uri (first (d:psis first-node))) + "http://test-tm/first-node")) + (is (= (length (d:psis second-node)) 1)) + (is (string= (d:uri (first (d:psis second-node))) + "http://test-tm/second-node")) + (is (= (length (d:psis third-node)) 1)) + (is (string= (d:uri (first (d:psis third-node))) + "http://test-tm/third-node")) + (is (= (length (d:psis fourth-node)) 0)) + (is (= (length (d:psis fifth-node)) 1)) + (is (string= (d:uri (first (d:psis fifth-node))) + "http://test-tm/fifth-node")) + (is (= (length (d:psis arc1)) 1)) + (is (string= (d:uri (first (d:psis arc1))) + "http://test/arcs/arc1")) + (is (= (length (d:psis arc2)))) + (is (string= (d:uri (first (d:psis arc2))) + "http://test/arcs/arc2")) + (is (= (length (d:psis arc3)))) + (is (string= (d:uri (first (d:psis arc3))) + "http://test/arcs/arc3")) + (is (= (length (d:psis arc4)))) + (is (string= (d:uri (first (d:psis arc4))) + "http://test/arcs/arc4")) + (is (= (length (d:used-as-type arc1)) 1)) + (is (eql (reifier (first (d:used-as-type arc1))) reification-1)) + (is (eql (reified reification-1) (first (d:used-as-type arc1)))) + (is (eql (reifier (first (d:used-as-type arc3))) reification-2)) + (is (eql (reified reification-2) (first (d:used-as-type arc3)))))))) + (elephant:close-store)) + ;;TODO: check rdf importer -;;TODO: check fragment exporter +;;TODO: check rdf exporter +;;TODO: check rdf-tm-reification-mapping ;;TODO: check merge-reifier-topics (--> versioning) +;;TODO: check fragment exporter ;;TODO: extend the fragment-importer in the RESTful-interface @@ -524,4 +640,5 @@ (it.bese.fiveam:run! 'test-xtm1.0-reification) (it.bese.fiveam:run! 'test-xtm2.0-reification) (it.bese.fiveam:run! 'test-xtm1.0-reification-exporter) - (it.bese.fiveam:run! 'test-xtm2.0-reification-exporter)) \ No newline at end of file + (it.bese.fiveam:run! 'test-xtm2.0-reification-exporter) + (it.bese.fiveam:run! 'test-rdf-importer-reification)) \ No newline at end of file Modified: trunk/src/xml/rdf/importer.lisp ============================================================================== --- trunk/src/xml/rdf/importer.lisp (original) +++ trunk/src/xml/rdf/importer.lisp Thu Nov 26 05:40:44 2009 @@ -354,10 +354,10 @@ :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)) + ;(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 @@ -365,6 +365,9 @@ :start-revision start-revision :instance-of assoc-type :roles a-roles)))) + (when reifier-id + (make-reification reifier-id assoc start-revision tm + :document-id document-id)) (format t "a") assoc))))) @@ -396,10 +399,10 @@ :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)) + ;(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 @@ -407,6 +410,9 @@ :start-revision start-revision :instance-of assoc-type :roles a-roles)))) + (when reifier-id + (make-reification reifier-id assoc start-revision tm + :document-id document-id)) (format t "a") assoc))))) @@ -503,14 +509,17 @@ :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)) + ;(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 :instance-of type-top :roles roles)))) + (when ID + (make-reification ID assoc start-revision tm + :document-id document-id)) (format t "a") assoc)))))) @@ -542,43 +551,52 @@ assoc))))) -(defun make-reification (reifier-id subject object predicate start-revision tm - &key document-id) - "Creates a reification construct." + +(defun make-reification(reifier-id reifiable-construct start-revision tm &key (document-id *document-id*)) (declare (string reifier-id)) - (declare ((or OccurrenceC TopicC) object)) - (declare (TopicC subject predicate)) + (declare (ReifiableConstructC reifiable-construct)) (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)))))) + (let ((reifier-topic (make-topic-stub reifier-id nil nil nil start-revision tm + :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 @@ -610,8 +628,10 @@ :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 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))))))

1 0

[isidorus-cvs] r153 - in trunk/src: unit_tests xml/xtm
by Lukas Giessmann 25 Nov '09

25 Nov '09

Author: lgiessmann Date: Wed Nov 25 09:47:32 2009 New Revision: 153 Log: added reification-support to the xtm2.0-exporter; added also some unit-tests for several cases in the exporter Modified: trunk/src/unit_tests/reification_test.lisp trunk/src/xml/xtm/exporter_xtm2.0.lisp 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 09:47:32 2009 @@ -28,7 +28,8 @@ :test-merge-reifier-topics :test-xtm1.0-reification :test-xtm2.0-reification - :test-xtm1.0-reification-exporter)) + :test-xtm1.0-reification-exporter + :test-xtm2.0-reification-exporter)) (in-package :reification-test) @@ -446,11 +447,73 @@ (handler-case (delete-file output-file) (error () )) ;do nothing (elephant:close-store)))) - + +(test test-xtm2.0-reification-exporter + "Tests the reification in the xtm2.0-exporter." + (let + ((dir "data_base") + (output-file "__out__.xtm") + (tm-id "http://www.isidor.us/unittests/reification-xtm2.0-tests")) + (with-fixture initialize-destination-db (dir) + (handler-case (delete-file output-file) + (error () )) ;do nothing + (xml-importer:import-xtm *reification_xtm2.0.xtm* dir + :tm-id tm-id + :xtm-id "reification-xtm") + (export-xtm output-file :tm-id tm-id) + (let ((document + (dom:document-element + (cxml:parse-file output-file (cxml-dom:make-dom-builder))))) + (let ((homer-topic + (loop for topic across (xpath-child-elems-by-qname document *xtm2.0-ns* "topic") + when (loop for psi across (xpath-child-elems-by-qname topic *xtm2.0-ns* "subjectIdentifier") + when (string= (dom:get-attribute psi "href") "http://simpsons.tv/homer") + return t) + return topic)) + (married-assoc (xpath-single-child-elem-by-qname document *xtm2.0-ns* "association"))) + (is-true homer-topic) + (is-true married-assoc) + (loop for occurrence across (xpath-child-elems-by-qname homer-topic *xtm2.0-ns* "occurrence") + do (is (string= (dom:get-attribute occurrence "reifier") "http://simpsons.tv/homer-occurrence"))) + (loop for name across (xpath-child-elems-by-qname homer-topic *xtm2.0-ns* "name") + do (is (string= (dom:get-attribute name "reifier") "http://simpsons.tv/homer-name"))) + (loop for name across (xpath-child-elems-by-qname homer-topic *xtm2.0-ns* "name") + do (loop for variant across (xpath-child-elems-by-qname name *xtm2.0-ns* "variant") + do (is (string= (dom:get-attribute variant "reifier") "http://simpsons.tv/homer-name-variant")))) + (is (string= (dom:get-attribute married-assoc "reifier") "http://simpsons.tv/married-association")) + (is-true (loop for role across (xpath-child-elems-by-qname married-assoc *xtm2.0-ns* "role") + when (string= (dom:get-attribute role "reifier") "http://simpsons.tv/married-husband-role") + return t)) + (is-true (loop for topic across (xpath-child-elems-by-qname document *xtm2.0-ns* "topic") + when (loop for ii across (xpath-child-elems-by-qname topic *xtm2.0-ns* "itemIdentity") + when (string= (dom:get-attribute ii "href") "http://simpsons.tv/homer-occurrence") + return t) + return t)) + (is-true (loop for topic across (xpath-child-elems-by-qname document *xtm2.0-ns* "topic") + when (loop for ii across (xpath-child-elems-by-qname topic *xtm2.0-ns* "itemIdentity") + when (string= (dom:get-attribute ii "href") "http://simpsons.tv/homer-name") + return t) + return t)) + (is-true (loop for topic across (xpath-child-elems-by-qname document *xtm2.0-ns* "topic") + when (loop for ii across (xpath-child-elems-by-qname topic *xtm2.0-ns* "itemIdentity") + when (string= (dom:get-attribute ii "href") "http://simpsons.tv/homer-name-variant") + return t) + return t)) + (is-true (loop for topic across (xpath-child-elems-by-qname document *xtm2.0-ns* "topic") + when (loop for ii across (xpath-child-elems-by-qname topic *xtm2.0-ns* "itemIdentity") + when (string= (dom:get-attribute ii "href") "http://simpsons.tv/married-association") + return t) + return t)) + (is-true (loop for topic across (xpath-child-elems-by-qname document *xtm2.0-ns* "topic") + when (loop for ii across (xpath-child-elems-by-qname topic *xtm2.0-ns* "itemIdentity") + when (string= (dom:get-attribute ii "href") "http://simpsons.tv/married-husband-role") + return t) + return t))))) + (elephant:close-store))) + ;;TODO: check rdf importer -;;TODO: check xtm2.0 exporter ;;TODO: check fragment exporter ;;TODO: check merge-reifier-topics (--> versioning) ;;TODO: extend the fragment-importer in the RESTful-interface @@ -461,4 +524,4 @@ (it.bese.fiveam:run! 'test-xtm1.0-reification) (it.bese.fiveam:run! 'test-xtm2.0-reification) (it.bese.fiveam:run! 'test-xtm1.0-reification-exporter) - ) \ No newline at end of file + (it.bese.fiveam:run! 'test-xtm2.0-reification-exporter)) \ No newline at end of file Modified: trunk/src/xml/xtm/exporter_xtm2.0.lisp ============================================================================== --- trunk/src/xml/xtm/exporter_xtm2.0.lisp (original) +++ trunk/src/xml/xtm/exporter_xtm2.0.lisp Wed Nov 25 09:47:32 2009 @@ -9,6 +9,16 @@ (in-package :exporter) +(defun to-reifier-elem (reifiable-construct) + "Exports the reifier-attribute. + The attribute is only exported if the reifier-topic contains at least + one item-identifier." + (declare (ReifiableConstructC reifiable-construct)) + (when (and (reifier reifiable-construct) + (item-identifiers (reifier reifiable-construct))) + (cxml:attribute "reifier" + (uri (first (item-identifiers (reifier reifiable-construct))))))) + (defun ref-to-elem (topic) (declare (TopicC topic)) (cxml:with-element "t:topicRef" @@ -29,6 +39,7 @@ "name = element name { reifiable, type?, scope?, value, variant* }" (cxml:with-element "t:name" + (to-reifier-elem name) (map 'list #'to-elem (item-identifiers name)) (when (slot-boundp name 'instance-of) (cxml:with-element "t:type" @@ -74,6 +85,7 @@ (defmethod to-elem ((variant VariantC)) "variant = element variant { reifiable, scope, (resourceRef | resourceData) }" (cxml:with-element "t:variant" + (to-reifier-elem variant) (map 'list #'to-elem (item-identifiers variant)) (when (themes variant) (cxml:with-element "t:scope" @@ -91,6 +103,7 @@ "occurrence = element occurrence { reifiable, type, scope?, (resourceRef | resourceData) }" (cxml:with-element "t:occurrence" + (to-reifier-elem occ) (map 'list #'to-elem (item-identifiers occ)) (cxml:with-element "t:type" (ref-to-elem (instance-of occ))) @@ -138,6 +151,7 @@ (defmethod to-elem ((role RoleC)) "role = element role { reifiable, type, topicRef }" (cxml:with-element "t:role" + (to-reifier-elem role) (map 'list #'to-elem (item-identifiers role)) (cxml:with-element "t:type" (ref-to-elem (instance-of role))) @@ -147,6 +161,7 @@ (defmethod to-elem ((assoc AssociationC)) "association = element association { reifiable, type, scope?, role+ }" (cxml:with-element "t:association" + (to-reifier-elem assoc) (map 'list #'to-elem (item-identifiers assoc)) (cxml:with-element "t:type" (ref-to-elem (instance-of assoc)))

1 0

[isidorus-cvs] r152 - in trunk/src: model unit_tests xml/xtm
by Lukas Giessmann 25 Nov '09

25 Nov '09

Author: lgiessmann Date: Wed Nov 25 08:05:02 2009 New Revision: 152 Log: added the support for reification to the xtm1.0 exporter; added alos some unit-tests for the exporter Modified: trunk/src/model/datamodel.lisp trunk/src/unit_tests/reification_test.lisp trunk/src/xml/xtm/exporter_xtm1.0.lisp Modified: trunk/src/model/datamodel.lisp ============================================================================== --- trunk/src/model/datamodel.lisp (original) +++ trunk/src/model/datamodel.lisp Wed Nov 25 08:05:02 2009 @@ -1245,9 +1245,9 @@ (if tm (remove-if-not (lambda (role) - (format t "player: ~a" (player role)) - (format t "parent: ~a" (parent role)) - (format t "topic: ~a~&" topic) + ;(format t "player: ~a" (player role)) + ;(format t "parent: ~a" (parent role)) + ;(format t "topic: ~a~&" topic) (in-topicmap tm (parent role))) (player-in-roles topic)) (player-in-roles 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 08:05:02 2009 @@ -13,13 +13,22 @@ :datamodel :it.bese.FiveAM :unittests-constants - :fixtures) + :fixtures + :exporter) + (:import-from :constants + *xtm2.0-ns* + *xtm1.0-ns* + *xtm1.0-xlink*) + (:import-from :xml-tools + xpath-child-elems-by-qname xpath-single-child-elem-by-qname + xpath-fn-string) (:export :reification-test :run-reification-tests :test-merge-reifier-topics :test-xtm1.0-reification - :test-xtm2.0-reification)) + :test-xtm2.0-reification + :test-xtm1.0-reification-exporter)) (in-package :reification-test) @@ -348,8 +357,99 @@ (elephant:close-store)))) +(test test-xtm1.0-reification-exporter + "Tests the reification in the xtm1.0-exporter." + (let + ((dir "data_base") + (output-file "__out__.xtm") + (tm-id "http://www.isidor.us/unittests/reification-xtm1.0-tests")) + (with-fixture initialize-destination-db (dir) + (handler-case (delete-file output-file) + (error () )) ;do nothing + (xml-importer:import-xtm *reification_xtm1.0.xtm* dir + :tm-id tm-id + :xtm-id "reification-xtm" + :xtm-format '1.0) + (export-xtm output-file :xtm-format '1.0 :tm-id tm-id) + (let ((document + (dom:document-element + (cxml:parse-file output-file (cxml-dom:make-dom-builder))))) + (let ((homer-topic + (loop for topic across (xpath-child-elems-by-qname document *xtm1.0-ns* "topic") + when (loop for subjectIndicatorRef across (xpath-child-elems-by-qname + (xpath-single-child-elem-by-qname + topic *xtm1.0-ns* "subjectIdentity") + *xtm1.0-ns* "subjectIndicatorRef") + when (string= (dom:get-attribute-ns subjectIndicatorRef *xtm1.0-xlink* "href") + "http://simpsons.tv/homer") + return t) + return topic)) + (married-assoc (xpath-single-child-elem-by-qname document *xtm1.0-ns* "association"))) + (is-true homer-topic) + (is-true married-assoc) + (loop for occurrence across (xpath-child-elems-by-qname homer-topic *xtm1.0-ns* "occurrence") + do (is (string= (dom:get-attribute occurrence "id") "homer-occurrence"))) + (loop for name across (xpath-child-elems-by-qname homer-topic *xtm1.0-ns* "baseName") + do (progn (is (string= (dom:get-attribute name "id") "homer-name")) + (loop for variant across (xpath-child-elems-by-qname name *xtm1.0-ns* "variant") + do (is (string= (dom:get-attribute variant "id") "homer-name-variant"))))) + (is (string= (dom:get-attribute married-assoc "id") "a-married")) + (is-true (loop for role across (xpath-child-elems-by-qname married-assoc *xtm1.0-ns* "member") + when (string= (dom:get-attribute role "id") + "married-husband-role") + return t))) + (is-true (loop for topic across (xpath-child-elems-by-qname document *xtm1.0-ns* "topic") + when (loop for subjectIndicatorRef across (xpath-child-elems-by-qname + (xpath-single-child-elem-by-qname + topic *xtm1.0-ns* "subjectIdentity") + *xtm1.0-ns* "subjectIndicatorRef") + when (string= (dom:get-attribute-ns subjectIndicatorRef *xtm1.0-xlink* "href") + "#homer-occurrence") + return t) + return t)) + (is-true (loop for topic across (xpath-child-elems-by-qname document *xtm1.0-ns* "topic") + when (loop for subjectIndicatorRef across (xpath-child-elems-by-qname + (xpath-single-child-elem-by-qname + topic *xtm1.0-ns* "subjectIdentity") + *xtm1.0-ns* "subjectIndicatorRef") + when (string= (dom:get-attribute-ns subjectIndicatorRef *xtm1.0-xlink* "href") + "#homer-name") + return t) + return t)) + (is-true (loop for topic across (xpath-child-elems-by-qname document *xtm1.0-ns* "topic") + when (loop for subjectIndicatorRef across (xpath-child-elems-by-qname + (xpath-single-child-elem-by-qname + topic *xtm1.0-ns* "subjectIdentity") + *xtm1.0-ns* "subjectIndicatorRef") + when (string= (dom:get-attribute-ns subjectIndicatorRef *xtm1.0-xlink* "href") + "#homer-name-variant") + return t) + return t)) + (is-true (loop for topic across (xpath-child-elems-by-qname document *xtm1.0-ns* "topic") + when (loop for subjectIndicatorRef across (xpath-child-elems-by-qname + (xpath-single-child-elem-by-qname + topic *xtm1.0-ns* "subjectIdentity") + *xtm1.0-ns* "subjectIndicatorRef") + when (string= (dom:get-attribute-ns subjectIndicatorRef *xtm1.0-xlink* "href") + "#a-married") + return t) + return t)) + (is-true (loop for topic across (xpath-child-elems-by-qname document *xtm1.0-ns* "topic") + when (loop for subjectIndicatorRef across (xpath-child-elems-by-qname + (xpath-single-child-elem-by-qname + topic *xtm1.0-ns* "subjectIdentity") + *xtm1.0-ns* "subjectIndicatorRef") + when (string= (dom:get-attribute-ns subjectIndicatorRef *xtm1.0-xlink* "href") + "#married-husband-role") + return t) + return t))) + (handler-case (delete-file output-file) + (error () )) ;do nothing + (elephant:close-store)))) + + + ;;TODO: check rdf importer -;;TODO: check xtm1.0 exporter ;;TODO: check xtm2.0 exporter ;;TODO: check fragment exporter ;;TODO: check merge-reifier-topics (--> versioning) @@ -360,4 +460,5 @@ (it.bese.fiveam:run! 'test-merge-reifier-topics) (it.bese.fiveam:run! 'test-xtm1.0-reification) (it.bese.fiveam:run! 'test-xtm2.0-reification) + (it.bese.fiveam:run! 'test-xtm1.0-reification-exporter) ) \ No newline at end of file Modified: trunk/src/xml/xtm/exporter_xtm1.0.lisp ============================================================================== --- trunk/src/xml/xtm/exporter_xtm1.0.lisp (original) +++ trunk/src/xml/xtm/exporter_xtm1.0.lisp Wed Nov 25 08:05:02 2009 @@ -34,6 +34,23 @@ (cxml:attribute "xlink:href" (format nil "#~a" (topicid topic))))) +(defun to-reifier-elem-xtm1.0 (reifiable-construct) + "Exports an ID indicating a reifier. + The reifier is only exported if the reifier-topic contains a PSI starting with #. + This may cause differences since the xtm2.0 defines the referencing + of reifiers with item-identifiers." + (declare (ReifiableConstructC reifiable-construct)) + (when (reifier reifiable-construct) + (let ((reifier-psi + (find-if #'(lambda(x) + (when (and (stringp (uri x)) + (> (length (uri x)) 0)) + (eql (elt (uri x) 0) #\#))) + (psis (reifier reifiable-construct))))) + (when reifier-psi + (cxml:attribute "id" (subseq (uri reifier-psi) 1 (length (uri reifier-psi)))))))) + + (defun to-resourceX-elem-xtm1.0 (characteristic) (declare (CharacteristicC characteristic)) (let ((characteristic-value @@ -90,6 +107,7 @@ (defmethod to-elem-xtm1.0 ((variant VariantC)) "variant = element { parameters, variantName?, variant* }" (cxml:with-element "t:variant" + (to-reifier-elem-xtm1.0 variant) (when (themes variant) (cxml:with-element "t:parameters" (map 'list #'to-topicRef-elem-xtm1.0 (themes variant)))) @@ -100,6 +118,7 @@ (defmethod to-elem-xtm1.0 ((name NameC)) "baseName = element baseName { scope?, baseNameString, variant* }" (cxml:with-element "t:baseName" + (to-reifier-elem-xtm1.0 name) (when (themes name) (to-scope-elem-xtm1.0 name)) (cxml:with-element "t:baseNameString" @@ -114,6 +133,7 @@ "occurrence = element occurrence { instanceOf?, scope?, (resourceRef | resourceData) }" (cxml:with-element "t:occurrence" + (to-reifier-elem-xtm1.0 occurrence) (when (instance-of occurrence) (to-instanceOf-elem-xtm1.0 (instance-of occurrence))) (when (themes occurrence) @@ -146,6 +166,7 @@ "member = element member { roleSpec?, (topicRef | resourceRef | subjectIndicatorRef)+ }" (cxml:with-element "t:member" + (to-reifier-elem-xtm1.0 role) (when (instance-of role) (to-roleSpec-elem-xtm1.0 (instance-of role))) (to-topicRef-elem-xtm1.0 (player role)))) @@ -154,6 +175,7 @@ (defmethod to-elem-xtm1.0 ((association AssociationC)) "association = element association { instanceOf?, scope?, member+ }" (cxml:with-element "t:association" + (to-reifier-elem-xtm1.0 association) (when (instance-of association) (to-instanceOf-elem-xtm1.0 (instance-of association))) (when (themes association)

1 0

[isidorus-cvs] r151 - in trunk/src: model unit_tests xml/xtm
by Lukas Giessmann 25 Nov '09

25 Nov '09

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)))))

1 0

[isidorus-cvs] r150 - trunk/src/unit_tests
by Lukas Giessmann 24 Nov '09

24 Nov '09

Author: lgiessmann Date: Tue Nov 24 11:17:34 2009 New Revision: 150 Log: added a unit-test for reification in the xtm2.0-importer Modified: trunk/src/unit_tests/reification_test.lisp trunk/src/unit_tests/reification_xtm2.0.xtm trunk/src/unit_tests/unittests-constants.lisp 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 11:17:34 2009 @@ -18,7 +18,8 @@ :reification-test :run-reification-tests :test-merge-reifier-topics - :test-xtm1.0-reification)) + :test-xtm1.0-reification + :test-xtm2.0-reification)) (in-package :reification-test) @@ -278,7 +279,75 @@ (elephant:close-store)))) -;;TODO: check xtm2.0 importer +(test test-xtm2.0-reification + "Tests the reification in the xtm2.0-importer." + (let + ((dir "data_base")) + (with-fixture initialize-destination-db (dir) + (xml-importer:import-xtm *reification_xtm2.0.xtm* dir + :tm-id "http://www.isidor.us/unittests/reification-xtm2.0-tests" + :xtm-id "reification-xtm") + (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 'ItemIdentifierC 'uri "http://simpsons.tv/homer-occurrence"))) + (reifier-name + (identified-construct (elephant:get-instance-by-value 'ItemIdentifierC 'uri "http://simpsons.tv/homer-name"))) + (reifier-variant + (identified-construct (elephant:get-instance-by-value 'ItemIdentifierC 'uri "http://simpsons.tv/homer-name-variant"))) + (reifier-married-assoc + (identified-construct (elephant:get-instance-by-value 'ItemIdentifierC 'uri "http://simpsons.tv/married-association"))) + (reifier-husband-role + (identified-construct (elephant:get-instance-by-value 'ItemIdentifierC 'uri "http://simpsons.tv/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 rdf importer ;;TODO: check xtm1.0 exporter ;;TODO: check xtm2.0 exporter @@ -288,5 +357,6 @@ (defun run-reification-tests () (it.bese.fiveam:run! 'test-merge-reifier-topics) - (it.bese.fiveam:run! 'test-xtm1.0-refication) + (it.bese.fiveam:run! 'test-xtm1.0-reification) + (it.bese.fiveam:run! 'test-xtm2.0-reification) ) \ No newline at end of file Modified: trunk/src/unit_tests/reification_xtm2.0.xtm ============================================================================== --- trunk/src/unit_tests/reification_xtm2.0.xtm (original) +++ trunk/src/unit_tests/reification_xtm2.0.xtm Tue Nov 24 11:17:34 2009 @@ -39,23 +39,23 @@ </tm:topic> <tm:topic id="fullName"> - <tm:subjectIdentiifer href="http://simpsons.tv/fullName"/> + <tm:subjectIdentifier href="http://simpsons.tv/fullName"/> </tm:topic> <tm:topic id="profession"> - <tm:subjectIdentiifer href="http://simpsons.tv/profession"/> + <tm:subjectIdentifier href="http://simpsons.tv/profession"/> </tm:topic> <tm:topic id="married"> - <tm:subjectIdentiifer href="http://simpsons.tv/married"/> + <tm:subjectIdentifier href="http://simpsons.tv/married"/> </tm:topic> <tm:topic id="husband"> - <tm:subjectIdentiifer href="http://simpsons.tv/husband"/> + <tm:subjectIdentifier href="http://simpsons.tv/husband"/> </tm:topic> <tm:topic id="wife"> - <tm:subjectIdentiifer href="http://simpsons.tv/wife"/> + <tm:subjectIdentifier href="http://simpsons.tv/wife"/> </tm:topic> <tm:association reifier="http://simpsons.tv/married-association"> 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 11:17:34 2009 @@ -32,7 +32,8 @@ :*poems_light.rdf* :*poems_light.xtm* :*full_mapping.rdf* - :*reification_xtm1.0.xtm*)) + :*reification_xtm1.0.xtm* + :*reification_xtm2.0.xtm*)) (in-package :unittests-constants) @@ -108,4 +109,8 @@ (defparameter *reification_xtm1.0.xtm* (asdf:component-pathname - (asdf:find-component *unit-tests-component* "reification_xtm1.0.xtm"))) \ No newline at end of file + (asdf:find-component *unit-tests-component* "reification_xtm1.0.xtm"))) + +(defparameter *reification_xtm2.0.xtm* + (asdf:component-pathname + (asdf:find-component *unit-tests-component* "reification_xtm2.0.xtm"))) \ No newline at end of file

1 0

[isidorus-cvs] r149 - in trunk/src: . unit_tests
by Lukas Giessmann 24 Nov '09

24 Nov '09

Author: lgiessmann Date: Tue Nov 24 10:56:09 2009 New Revision: 149 Log: added an xtm2.0-reification test file Added: trunk/src/unit_tests/reification_xtm2.0.xtm (contents, props changed) Modified: trunk/src/isidorus.asd Modified: trunk/src/isidorus.asd ============================================================================== --- trunk/src/isidorus.asd (original) +++ trunk/src/isidorus.asd Tue Nov 24 10:56:09 2009 @@ -112,6 +112,7 @@ (:static-file "poems_light.xtm") (:static-file "full_mapping.rdf") (:static-file "reification_xtm1.0.xtm") + (:static-file "reification_xtm2.0.xtm") (:file "atom-conf") (:file "unittests-constants" :depends-on ("dangling_topicref.xtm" Added: trunk/src/unit_tests/reification_xtm2.0.xtm ============================================================================== --- (empty file) +++ trunk/src/unit_tests/reification_xtm2.0.xtm Tue Nov 24 10:56:09 2009 @@ -0,0 +1,94 @@ +<?xml version="1.0"?> + + + + + + + + +<tm:topicMap xmlns:tm="http://www.topicmaps.org/xtm/" version="2.0"> + <tm:topic id="homer"> + <tm:subjectIdentifier href="http://simpsons.tv/homer"/> + <tm:name reifier="http://simpsons.tv/homer-name"> + <tm:value>Homer Simpson</tm:value> + <tm:variant reifier="http://simpsons.tv/homer-name-variant"> + <tm:scope><tm:topicRef href="#fullName"/></tm:scope> + <tm:resourceData>Homer Jay Simpson</tm:resourceData> + </tm:variant> + </tm:name> + <tm:occurrence reifier="http://simpsons.tv/homer-occurrence"> + <tm:type><tm:topicRef href="#profession"/></tm:type> + <tm:resourceData>Safety Inspector</tm:resourceData> + </tm:occurrence> + </tm:topic> + + <tm:topic id="marge"> + <tm:subjectIdentifier href="http://simpsons.tv/marge"/> + <tm:name> + <tm:value>Marge Simpson</tm:value> + <tm:variant> + <tm:scope><tm:topicRef href="#fullName"/></tm:scope> + <tm:resourceData>Marjorie Simpson</tm:resourceData> + </tm:variant> + </tm:name> + <tm:occurrence> + <tm:type><tm:topicRef href="#profession"/></tm:type> + <tm:resourceData>Housewife</tm:resourceData> + </tm:occurrence> + </tm:topic> + + <tm:topic id="fullName"> + <tm:subjectIdentiifer href="http://simpsons.tv/fullName"/> + </tm:topic> + + <tm:topic id="profession"> + <tm:subjectIdentiifer href="http://simpsons.tv/profession"/> + </tm:topic> + + <tm:topic id="married"> + <tm:subjectIdentiifer href="http://simpsons.tv/married"/> + </tm:topic> + + <tm:topic id="husband"> + <tm:subjectIdentiifer href="http://simpsons.tv/husband"/> + </tm:topic> + + <tm:topic id="wife"> + <tm:subjectIdentiifer href="http://simpsons.tv/wife"/> + </tm:topic> + + <tm:association reifier="http://simpsons.tv/married-association"> + <tm:type><tm:topicRef href="#married"/></tm:type> + <tm:role reifier="http://simpsons.tv/married-husband-role"> + <tm:type><tm:topicRef href="#husband"/></tm:type> + <tm:topicRef href="#homer"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#wife"/></tm:type> + <tm:topicRef href="#marge"/> + </tm:role> + </tm:association> + + +  + <tm:topic id="homer-name-reifier"> + <tm:itemIdentity href="http://simpsons.tv/homer-name"/> + </tm:topic> + + <tm:topic id="homer-name-variant-reifier"> + <tm:itemIdentity href="http://simpsons.tv/homer-name-variant"/> + </tm:topic> + + <tm:topic id="homer-occurrence-reifier"> + <tm:itemIdentity href="http://simpsons.tv/homer-occurrence"/> + </tm:topic> + + <tm:topic id="married-reifier"> + <tm:itemIdentity href="http://simpsons.tv/married-association"/> + </tm:topic> + + <tm:topic id="married-husband-reifier"> + <tm:itemIdentity href="http://simpsons.tv/married-husband-role"/> + </tm:topic> +</tm:topicMap>

1 0

[isidorus-cvs] r148 - in trunk/src: . model unit_tests xml/xtm
by Lukas Giessmann 24 Nov '09

24 Nov '09

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)))))

1 0

[isidorus-cvs] r147 - trunk/src/unit_tests
by Lukas Giessmann 23 Nov '09

23 Nov '09

Author: lgiessmann Date: Mon Nov 23 14:02:30 2009 New Revision: 147 Log: added a reification-test-file for the xtm1.0 importer Added: trunk/src/unit_tests/reification_xtm1.0.xtm (contents, props changed) Modified: trunk/src/unit_tests/reification_test.lisp Modified: trunk/src/unit_tests/reification_test.lisp ============================================================================== --- trunk/src/unit_tests/reification_test.lisp (original) +++ trunk/src/unit_tests/reification_test.lisp Mon Nov 23 14:02:30 2009 @@ -207,9 +207,17 @@ (elephant:close-store)))))) -;;TODO: check xtm1.0 importer +(test test-xtm1.0-reification + "Tests the reification in the xtm1.0-importer." + + ) + + + ;;TODO: check xtm2.0 importer ;;TODO: check rdf importer +;;TODO: check xtm1.0 exporter +;;TODO: check xtm2.0 exporter ;;TODO: check fragment exporter Added: trunk/src/unit_tests/reification_xtm1.0.xtm ============================================================================== --- (empty file) +++ trunk/src/unit_tests/reification_xtm1.0.xtm Mon Nov 23 14:02:30 2009 @@ -0,0 +1,160 @@ +<?xml version="1.0"?> + + + + + + + + + +<topicMap xmlns="http://www.topicmaps.org/xtm/1.0/" + xmlns:xlink="http://www.w3.org/1999/xlink"> + <t:topic xmlns:t="http://www.topicmaps.org/xtm/1.0/" + xmlns:xlink="http://www.w3.org/1999/xlink" + id="homer"> + <t:subjectIdentity> + <t:subjectIndicatorRef xlink:href="http://simpsons.tv/homer"/> + </t:subjectIdentity> + <t:baseName id="homer-name"> + <t:baseNameString>Homer Simpson</t:baseNameString> + <t:variant id="homer-name-variant"> + <t:parameters><t:topicRef xlink:href="#fullName"/></t:parameters> + <t:variantName> + <t:resourceData>Homer Jay Simpson</t:resourceData> + </t:variantName> + </t:variant> + </t:baseName> + <t:occurrence id="homer-occurrence"> + <t:instanceOf> + <t:topicRef xlink:href="#profession"/> + </t:instanceOf> + <t:resourceData>Safety Inspector</t:resourceData> + </t:occurrence> + </t:topic> + + <t:topic xmlns:t="http://www.topicmaps.org/xtm/1.0/" + xmlns:xlink="http://www.w3.org/1999/xlink" + id="marge"> + <t:subjectIdentity> + <t:subjectIndicatorRef xlink:href="http://simpsons.tv/marge"/> + </t:subjectIdentity> + <t:baseName> + <t:baseNameString>Marge Simpson</t:baseNameString> + <t:variant> + <t:parameters><t:topicRef xlink:href="#fullName"/></t:parameters> + <t:variantName> + <t:resourceData>Marjorie Simpson</t:resourceData> + </t:variantName> + </t:variant> + </t:baseName> + <t:occurrence> + <t:instanceOf> + <t:topicRef xlink:href="#profession"/> + </t:instanceOf> + <t:resourceData>Housewife</t:resourceData> + </t:occurrence> + </t:topic> + + <t:topic xmlns:t="http://www.topicmaps.org/xtm/1.0/" + xmlns:xlink="http://www.w3.org/1999/xlink" + id="fullName"> + <t:subjectIdentity> + <t:subjectIndicatorRef xlink:href="http://simpsons.tv/fullName"/> + </t:subjectIdentity> + </t:topic> + + <t:topic xmlns:t="http://www.topicmaps.org/xtm/1.0/" + xmlns:xlink="http://www.w3.org/1999/xlink" + id="profession"> + <t:subjectIdentity> + <t:subjectIndicatorRef xlink:href="http://simpsons.tv/profession"/> + </t:subjectIdentity> + </t:topic> + + <t:topic xmlns:t="http://www.topicmaps.org/xtm/1.0/" + xmlns:xlink="http://www.w3.org/1999/xlink" + id="married"> + <t:subjectIdentity> + <t:subjectIndicatorRef xlink:href="http://simpsons.tv/married"/> + </t:subjectIdentity> + </t:topic> + + <t:topic xmlns:t="http://www.topicmaps.org/xtm/1.0/" + xmlns:xlink="http://www.w3.org/1999/xlink" + id="husband"> + <t:subjectIdentity> + <t:subjectIndicatorRef xlink:href="http://simpsons.tv/husband"/> + </t:subjectIdentity> + </t:topic> + + <t:topic xmlns:t="http://www.topicmaps.org/xtm/1.0/" + xmlns:xlink="http://www.w3.org/1999/xlink" + id="wife"> + <t:subjectIdentity> + <t:subjectIndicatorRef xlink:href="http://simpsons.tv/wife"/> + </t:subjectIdentity> + </t:topic> + + <t:association xmlns:t="http://www.topicmaps.org/xtm/1.0/" + xmlns:xlink="http://www.w3.org/1999/xlink" + id="a-married"> + <t:instanceOf> + <t:topicRef xlink:href="#married"/> + </t:instanceOf> + <t:member id="married-husband-role"> + <t:roleSpec> + <t:topicRef xlink:href="#husband"/> + </t:roleSpec> + <t:topicRef xlink:href="#homer"/> + </t:member> + <t:member> + <t:roleSpec> + <t:topicRef xlink:href="#wife"/> + </t:roleSpec> + <t:topicRef xlink:href="#marge"/> + </t:member> + </t:association> + + +  + <t:topic xmlns:t="http://www.topicmaps.org/xtm/1.0/" + xmlns:xlink="http://www.w3.org/1999/xlink" + id="homer-name-reifier"> + <t:subjectIdentity> + <t:subjectIndicatorRef xlink:href="#homer-name"/> + </t:subjectIdentity> + </t:topic> + + <t:topic xmlns:t="http://www.topicmaps.org/xtm/1.0/" + xmlns:xlink="http://www.w3.org/1999/xlink" + id="homer-name-variant-reifier"> + <t:subjectIdentity> + <t:subjectIndicatorRef xlink:href="#homer-name-variant"/> + </t:subjectIdentity> + </t:topic> + + <t:topic xmlns:t="http://www.topicmaps.org/xtm/1.0/" + xmlns:xlink="http://www.w3.org/1999/xlink" + id="homer-occurrence-reifier"> + <t:subjectIdentity> + <t:subjectIndicatorRef xlink:href="#homer-occurrence"/> + </t:subjectIdentity> + </t:topic> + + <t:topic xmlns:t="http://www.topicmaps.org/xtm/1.0/" + xmlns:xlink="http://www.w3.org/1999/xlink" + id="married-reifier"> + <t:subjectIdentity> + <t:subjectIndicatorRef xlink:href="#a-married"/> + </t:subjectIdentity> + </t:topic> + + <t:topic xmlns:t="http://www.topicmaps.org/xtm/1.0/" + xmlns:xlink="http://www.w3.org/1999/xlink" + id="married-husband-reifier"> + <t:subjectIdentity> + <t:subjectIndicatorRef xlink:href="#married-husband"/> + </t:subjectIdentity> + </t:topic> +</topicMap>

1 0

[isidorus-cvs] r146 - in trunk/src: model xml/xtm
by Lukas Giessmann 22 Nov '09

22 Nov '09

Author: lgiessmann Date: Sun Nov 22 15:11:48 2009 New Revision: 146 Log: added the support of reification in xtm1.0 Modified: trunk/src/model/datamodel.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 Sun Nov 22 15:11:48 2009 @@ -1585,34 +1585,36 @@ ;;;;;;;;;;;;;;;;; ;; reification -(defgeneric add-reifier (construct reifier-uri) - (:method ((construct ReifiableConstructC) reifier-uri) +(defgeneric add-reifier (construct reifier-uri reifier-must-exist) + (:method ((construct ReifiableConstructC) reifier-uri reifier-must-exist) (let ((err "From add-reifier(): ")) (let ((item-identifier - (elephant:get-instance-by-value 'Item-IdentifierC 'uri reifier-uri))) + (elephant:get-instance-by-value 'ItemIdentifierC 'uri reifier-uri))) (unless item-identifier - (error "~ano item-identifier could be found with the uri ~a" - err reifier-uri)) - (let ((reifier-topic (identified-construct item-identifier))) - (unless (typep reifier-topic 'TopicC) - (error "~anitem-identifier ~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)) - ((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)) + (when reifier-must-exist + (error "~ano item-identifier could be found with the uri ~a" + err reifier-uri))) + (when item-identifier + (let ((reifier-topic (identified-construct item-identifier))) + (unless (typep reifier-topic 'TopicC) + (error "~anitem-identifier ~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)) + ((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))) - (merge-reifier-topics (reifier construct) 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)) 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 Sun Nov 22 15:11:48 2009 @@ -9,6 +9,19 @@ (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." + (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"))))) + (when (and (stringp reifier-uri) + (> (length reifier-uri) 0)) + (add-reifier reifiable-construct (concatenate 'string "#" reifier-uri) nil)) + reifiable-construct)) + + (defun get-topic-id-xtm1.0 (topic-elem) "returns the id attribute of a topic element" (declare (dom:element topic-elem)) @@ -77,6 +90,7 @@ :charvalue (getf variantName :data) :datatype (getf variantName :type) :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)) @@ -138,6 +152,7 @@ :topic top :charvalue baseNameString :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")) @@ -248,13 +263,14 @@ (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"))) - (make-construct 'OccurrenceC - :start-revision start-revision - :topic top - :themes themes - :instance-of instanceOf - :charvalue (getf occurrence-value :data) - :datatype (getf occurrence-value :type)))) + (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)))) (defun from-subjectIdentity-elem-xtm1.0 (subjectIdentity-elem start-revision) @@ -308,11 +324,17 @@ (xpath-child-elems-by-qname member-elem *xtm1.0-ns* - "subjectIndicatorRef")))))))) + "subjectIndicatorRef"))))))) + (reifier-uri + (when (dom:get-attribute-node member-elem "id") + (concatenate 'string "#" (dom:node-value (dom:get-attribute-node member-elem "id")))))) (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))))) + (list :instance-of type + :player (first player) + :item-identifiers nil + :reifier-uri reifier-uri))))) (defun from-topic-elem-to-stub-xtm1.0 (topic-elem start-revision @@ -399,9 +421,19 @@ :instance-of type :themes themes :roles roles))) - (add-to-topicmap tm association) - association)))) - + (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)) + (add-reifier assoc-role (getf list-role :reifier-uri) nil))) + roles)) + (roles association)))))) + (defun set-standard-role-types (roles) "sets the missing role types of the passed roles to the default types." 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 Sun Nov 22 15:11:48 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)) + (add-reifier reifiable-construct reifier-uri t)) 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)))) + (add-reifier assoc-role (getf list-role :reifier-uri) t))) roles)) (roles assoc)) (set-reifier assoc-elem assoc)))))

1 0

[isidorus-cvs] r145 - in trunk/src: model unit_tests xml/xtm
by Lukas Giessmann 22 Nov '09

22 Nov '09

Author: lgiessmann Date: Sun Nov 22 13:16:47 2009 New Revision: 145 Log: added the support for reification in the xtm 2.0 importer Modified: trunk/src/model/datamodel.lisp trunk/src/unit_tests/reification_test.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 Sun Nov 22 13:16:47 2009 @@ -1615,6 +1615,7 @@ (merge-reifier-topics (reifier construct) reifier-topic)))))) construct)) + (defgeneric merge-reifier-topics (old-topic new-topic) ;;the reifier topics are not only merged but also bound to the reified-construct (:method ((old-topic TopicC) (new-topic TopicC)) @@ -1632,8 +1633,10 @@ (dolist (scoped-construct (used-as-theme new-topic)) (remove-association scoped-construct 'themes new-topic) (add-association scoped-construct 'themes old-topic)) + ;merges all topic-maps (dolist (tm (in-topicmaps new-topic)) (add-association tm 'topic old-topic)) ;the new-topic is removed from this tm by deleting it + ;merges all role-players (dolist (a-role (player-in-roles new-topic)) (remove-association a-role 'player new-topic) (add-association a-role 'player old-topic)) Modified: trunk/src/unit_tests/reification_test.lisp ============================================================================== --- trunk/src/unit_tests/reification_test.lisp (original) +++ trunk/src/unit_tests/reification_test.lisp Sun Nov 22 13:16:47 2009 @@ -96,6 +96,20 @@ :topicid "name-type" :xtm-id xtm-id-1 :start-revision revision-1)) + (assoc-type (make-construct 'TopicC + :psis (list (make-instance 'PersistentIdC + :uri "psi-assoc-type" + :start-revision revision-1)) + :topicid "assoc-type" + :xtm-id xtm-id-1 + :start-revision revision-1)) + (role-type (make-construct 'TopicC + :psis (list (make-instance 'PersistentIdC + :uri "psi-role-type" + :start-revision revision-1)) + :topicid "assoc-type" + :xtm-id xtm-id-1 + :start-revision revision-1)) (occurrence-type (make-construct 'TopicC :psis (list (make-instance 'PersistentIdC :uri "psi-occurrence-type" @@ -143,10 +157,29 @@ :themes (list scope-1 topic-2) :instance-of topic-2 :charvalue "test-name" - :start-revision revision-2))) - (is (= (length (elephant:get-instances-by-class 'TopicC)) 6)) + :start-revision revision-2)) + (assoc (make-construct 'AssociationC + :item-identifiers nil + :instance-of assoc-type + :themes nil + :roles + (list + (list :instance-of role-type + :player topic-1 + :item-identifiers + (list (make-instance 'ItemIdentifierC + :uri "role-1" + :start-revision revision-1))) + (list :instance-of role-type + :player topic-2 + :item-identifiers + (list (make-instance 'ItemIdentifierC + :uri "role-2" + :start-revision revision-1)))) + :start-revision revision-1))) + (is (= (length (elephant:get-instances-by-class 'TopicC)) 8)) (datamodel::merge-reifier-topics topic-1 topic-2) - (is (= (length (elephant:get-instances-by-class 'TopicC)) 5)) + (is (= (length (elephant:get-instances-by-class 'TopicC)) 7)) (is (= (length (union (list ii-1-1 ii-1-2 ii-2-1 ii-2-2) (item-identifiers topic-1))) (length (list ii-1-1 ii-1-2 ii-2-1 ii-2-2)))) @@ -168,11 +201,18 @@ (is (= (length (union (d:used-as-theme topic-1) (list test-name))) (length (list test-name)))) - ;;TODO: roleplayer, topicmap + (is (eql (player (first (roles assoc))) topic-1)) + (is (eql (player (second (roles assoc))) topic-1)) ;;TODO: check all objects and their version-infos (elephant:close-store)))))) +;;TODO: check xtm1.0 importer +;;TODO: check xtm2.0 importer +;;TODO: check rdf importer +;;TODO: check fragment exporter + + (defun run-reification-tests () (it.bese.fiveam:run! 'test-merge-reifier-topics) ) \ No newline at end of file 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 Sun Nov 22 13:16:47 2009 @@ -9,6 +9,17 @@ (in-package :xml-importer) +(defun set-reifier (reifiable-elem reifiable-construct) + "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"))) + (when (and (stringp reifier-uri) + (> (length reifier-uri) 0)) + (add-reifier reifiable-construct reifier-uri)) + reifiable-construct)) + + (defun from-identifier-elem (classsymbol elem start-revision) "Generate an identifier object of type 'classsymbol' (a subclass of IdentifierC) from a given identifier element for a revision and return @@ -127,7 +138,7 @@ :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)) - name))) + (set-reifier name-elem name)))) (defun from-resourceX-elem (parent-elem) @@ -180,13 +191,14 @@ (unless variant-value (error "VariantC: one of resourceRef and resourceData must be set")) - (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))) + (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)))) (defun from-occurrence-elem (occ-elem top start-revision &key (xtm-id *current-xtm*)) @@ -211,14 +223,15 @@ (occurrence-value (from-resourceX-elem occ-elem))) (unless occurrence-value (error "OccurrenceC: one of resourceRef and resourceData must be set")) - (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)))) + (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)))) @@ -322,7 +335,13 @@ (xpath-single-child-elem-by-qname role-elem *xtm2.0-ns* - "topicRef")) :xtm-id xtm-id))) + "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")) (unless player ;instance-of will be set later - if there is no one @@ -331,7 +350,10 @@ role-elem *xtm2.0-ns* "topicRef")))) - (list :instance-of instance-of :player player :item-identifiers item-identifiers)))) + (list :reifier-uri reifier-uri + :instance-of instance-of + :player player + :item-identifiers item-identifiers)))) (defun from-association-elem (assoc-elem start-revision @@ -339,7 +361,7 @@ tm (xtm-id *current-xtm*)) "Constructs an AssociationC object from an association element -association = element association { reifiable, type, scope?, role+ }" + association = element association { reifiable, type, scope?, role+ }" (declare (dom:element assoc-elem)) (declare (integer start-revision)) (declare (TopicMapC tm)) @@ -366,14 +388,25 @@ assoc-elem *xtm2.0-ns* "role")))) (setf roles (set-standard-role-types roles)); sets standard role types if there are missing some of them - - (add-to-topicmap tm - (make-construct 'AssociationC - :start-revision start-revision - :item-identifiers item-identifiers - :instance-of instance-of - :themes themes - :roles roles))))) + (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)) + (add-reifier assoc-role (getf list-role :reifier-uri)))) + roles)) + (roles assoc)) + (set-reifier assoc-elem assoc)))))

1 0