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

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

22 Dec '09

Author: lgiessmann Date: Tue Dec 22 12:43:32 2009 New Revision: 173 Log: committed a working version before changing the datamodel Modified: trunk/src/model/datamodel.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 Tue Dec 22 12:43:32 2009 @@ -444,7 +444,7 @@ ;;;;;;;;;;;;;; ;; -;; PointerrC +;; PointerC (elephant:defpclass PointerC (TopicMapConstructC) ((uri :accessor uri 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 Dec 22 12:43:32 2009 @@ -257,9 +257,8 @@ (make-identifiers 'PersistentIdC topic-elem "subjectIdentifier" start-revision)) (subjectlocators (make-identifiers 'SubjectLocatorC topic-elem "subjectLocator" start-revision))) - - - (make-construct 'TopicC :start-revision start-revision + (make-construct 'TopicC + :start-revision start-revision :item-identifiers itemidentifiers :locators subjectlocators :psis subjectidentifiers

1 0

[isidorus-cvs] r172 - in trunk/src: model xml/rdf xml/xtm
by Lukas Giessmann 12 Dec '09

12 Dec '09

Author: lgiessmann Date: Fri Dec 11 19:29:01 2009 New Revision: 172 Log: added some more beauty to the xtm-importers in the reification-sections :-) Modified: trunk/src/model/datamodel.lisp trunk/src/xml/rdf/importer.lisp trunk/src/xml/xtm/importer_xtm1.0.lisp trunk/src/xml/xtm/importer_xtm2.0.lisp Modified: trunk/src/model/datamodel.lisp ============================================================================== --- trunk/src/model/datamodel.lisp (original) +++ trunk/src/model/datamodel.lisp Fri Dec 11 19:29:01 2009 @@ -1450,12 +1450,13 @@ (declare (list roles)) (let ((association (call-next-method))) - (dolist (role-tuple roles) + (dolist (role-data roles) (make-instance 'RoleC - :instance-of (getf role-tuple :instance-of) - :player (getf role-tuple :player) - :item-identifiers (getf role-tuple :item-identifiers) + :instance-of (getf role-data :instance-of) + :player (getf role-data :player) + :item-identifiers (getf role-data :item-identifiers) + :reifier (getf role-data :reifier) :parent association)))) (defmethod make-construct :around ((class-symbol (eql 'AssociationC)) Modified: trunk/src/xml/rdf/importer.lisp ============================================================================== --- trunk/src/xml/rdf/importer.lisp (original) +++ trunk/src/xml/rdf/importer.lisp Fri Dec 11 19:29:01 2009 @@ -354,10 +354,6 @@ :player super-top) (list :instance-of role-type-2 :player sub-top)))) - ;(when reifier-id - ;(make-reification reifier-id sub-top super-top - ; assoc-type start-revision tm - ; :document-id document-id)) (let ((assoc (add-to-topicmap tm @@ -399,10 +395,6 @@ :player type-top) (list :instance-of roletype-2 :player instance-top)))) - ;(when reifier-id - ; (make-reification reifier-id instance-top type-top - ; assoc-type start-revision tm - ; :document-id document-id)) (let ((assoc (add-to-topicmap tm @@ -509,9 +501,6 @@ :player player-1) (list :instance-of role-type-2 :player top)))) - ;(when ID - ; (make-reification ID top player-1 type-top start-revision - ; tm :document-id document-id)) (let ((assoc (add-to-topicmap tm (make-construct 'AssociationC :start-revision start-revision @@ -560,44 +549,6 @@ :document-id document-id))) (add-reifier reifiable-construct reifier-topic))) -;(defun make-reification (reifier-id subject object predicate start-revision tm -; &key document-id) -; "Creates a reification construct." -; (declare (string reifier-id)) -; (declare ((or OccurrenceC TopicC) object)) -; (declare (TopicC subject predicate)) -; (declare (TopicMapC tm)) -; (elephant:ensure-transaction (:txn-nosync t) -; (let ((reifier (make-topic-stub reifier-id nil nil nil start-revision tm -; :document-id document-id)) -; (predicate-arc (make-topic-stub *rdf-predicate* nil nil nil -; start-revision -; tm :document-id document-id)) -; (object-arc (make-topic-stub *rdf-object* nil nil nil start-revision -; tm :document-id document-id)) -; (subject-arc (make-topic-stub *rdf-subject* nil nil nil -; start-revision -; tm :document-id document-id)) -; (statement (make-topic-stub *rdf-statement* nil nil nil start-revision -; tm :document-id document-id))) -; (make-instance-of-association reifier statement nil start-revision tm -; :document-id document-id) -; (make-association-with-nodes reifier subject subject-arc tm -; start-revision :document-id document-id) -; (make-association-with-nodes reifier predicate predicate-arc -; tm start-revision :document-id document-id) -; (if (typep object 'd:TopicC) -; (make-association-with-nodes reifier object object-arc -; tm start-revision -; :document-id document-id) -; (make-construct 'd:OccurrenceC -; :start-revision start-revision -; :topic reifier -; :themes (themes object) -; :instance-of (instance-of object) -; :charvalue (charvalue object) -; :datatype (datatype object)))))) - (defun make-occurrence (top literal start-revision tm-id &key (document-id *document-id*)) @@ -628,8 +579,6 @@ :charvalue value :datatype datatype))) (when ID - ;(make-reification ID top occurrence type-top start-revision - ; xml-importer::tm :document-id document-id)) (make-reification ID occurrence start-revision xml-importer::tm :document-id document-id)) occurrence)))))) Modified: trunk/src/xml/xtm/importer_xtm1.0.lisp ============================================================================== --- trunk/src/xml/xtm/importer_xtm1.0.lisp (original) +++ trunk/src/xml/xtm/importer_xtm1.0.lisp Fri Dec 11 19:29:01 2009 @@ -9,10 +9,9 @@ (in-package :xml-importer) -(defun set-reifier-xtm1.0 (reifiable-elem reifiable-construct) - "Sets the reifier-topic of the passed elem to the passed construct." +(defun get-reifier-topic-xtm1.0 (reifiable-elem) + "Returns a reifier topic of the reifiable-element or nil." (declare (dom:element reifiable-elem)) - (declare (ReifiableConstructC reifiable-construct)) (let ((reifier-uri (when (dom:get-attribute-node reifiable-elem "id") (dom:node-value (dom:get-attribute-node reifiable-elem "id"))))) @@ -24,8 +23,7 @@ (when psi (let ((reifier-topic (identified-construct psi))) (when reifier-topic - (add-reifier reifiable-construct reifier-topic))))))) - reifiable-construct) + reifier-topic))))))) (defun get-topic-id-xtm1.0 (topic-elem) @@ -87,7 +85,8 @@ ((typep parent-construct 'VariantC) (name parent-construct)) (t - (error "from-variant-elem-xtm1.0: parent-cosntruct is neither NameC nor VariantC"))))) + (error "from-variant-elem-xtm1.0: parent-construct is neither NameC nor VariantC")))) + (reifier-topic (get-reifier-topic-xtm1.0 variant-elem))) (unless (and variantName parameters) (error "from-variant-elem-xtm1.0: parameters and variantName must be set")) (let ((variant (make-construct 'VariantC @@ -95,8 +94,8 @@ :themes parameters :charvalue (getf variantName :data) :datatype (getf variantName :type) + :reifier reifier-topic :name parent-name))) - (set-reifier-xtm1.0 variant-elem variant) (let ((inner-variants (map 'list #'(lambda(x) (from-variant-elem-xtm1.0 x variant start-revision :xtm-id xtm-id)) @@ -149,7 +148,8 @@ (xpath-single-child-elem-by-qname baseName-elem *xtm1.0-ns* "scope") :xtm-id xtm-id))) (baseNameString (xpath-fn-string - (xpath-single-child-elem-by-qname baseName-elem *xtm1.0-ns* "baseNameString")))) + (xpath-single-child-elem-by-qname baseName-elem *xtm1.0-ns* "baseNameString"))) + (reifier-topic (get-reifier-topic-xtm1.0 baseName-elem))) (unless baseNameString (error "A baseName must have exactly one baseNameString")) @@ -157,8 +157,8 @@ :start-revision start-revision :topic top :charvalue baseNameString + :reifier reifier-topic :themes themes))) - (set-reifier-xtm1.0 baseName-elem name) (map 'list #'(lambda(x) (from-variant-elem-xtm1.0 x name start-revision :xtm-id xtm-id)) (xpath-child-elems-by-qname baseName-elem *xtm1.0-ns* "variant")) @@ -262,21 +262,22 @@ (themes (from-scope-elem-xtm1.0 (xpath-single-child-elem-by-qname occ-elem *xtm1.0-ns* "scope") :xtm-id xtm-id)) - (occurrence-value - (from-resourceX-elem-xtm1.0 occ-elem))) + (occurrence-value + (from-resourceX-elem-xtm1.0 occ-elem)) + (reifier-topic (get-reifier-topic-xtm1.0 occ-elem))) (unless occurrence-value (error "from-occurrence-elem-xtm1.0: one of resourceRef and resourceData must be set")) (unless instanceOf (format t "from-occurrence-elem-xtm1.0: type is missing -> http://psi.topicmaps.org/iso13250/model/type-instance~%") (setf instanceOf (get-item-by-id "type-instance" :xtm-id "core.xtm"))) - (let ((occurrence (make-construct 'OccurrenceC - :start-revision start-revision - :topic top - :themes themes - :instance-of instanceOf - :charvalue (getf occurrence-value :data) - :datatype (getf occurrence-value :type)))) - (set-reifier-xtm1.0 occ-elem occurrence)))) + (make-construct 'OccurrenceC + :start-revision start-revision + :topic top + :themes themes + :instance-of instanceOf + :charvalue (getf occurrence-value :data) + :reifier reifier-topic + :datatype (getf occurrence-value :type)))) (defun from-subjectIdentity-elem-xtm1.0 (subjectIdentity-elem start-revision) @@ -331,16 +332,14 @@ member-elem *xtm1.0-ns* "subjectIndicatorRef"))))))) - (reifier-uri - (when (dom:get-attribute-node member-elem "id") - (concatenate 'string "#" (dom:node-value (dom:get-attribute-node member-elem "id")))))) + (reifier-topic (get-reifier-topic-xtm1.0 member-elem))) (declare (dom:element member-elem)) (unless player ; if no type is given a standard type will be assigend later in from-assoc... (error "from-member-elem-xtm1.0: missing player in role")) (list :instance-of type :player (first player) :item-identifiers nil - :reifier-uri reifier-uri))))) + :reifier reifier-topic))))) (defun from-topic-elem-to-stub-xtm1.0 (topic-elem start-revision @@ -413,41 +412,22 @@ #'(lambda(member-elem) (from-member-elem-xtm1.0 member-elem :xtm-id xtm-id)) - (xpath-child-elems-by-qname assoc-elem *xtm1.0-ns* "member")))) + (xpath-child-elems-by-qname assoc-elem *xtm1.0-ns* "member"))) + (reifier-topic (get-reifier-topic-xtm1.0 assoc-elem))) (unless roles (error "from-association-elem-xtm1.0: roles are missing in association")) (setf roles (set-standard-role-types roles)) (unless type (format t "from-association-elem-xtm1.0: type is missing -> http://www.topicmaps.org/xtm/1.0/core.xtm#association~%") (setf type (get-item-by-id "association" :xtm-id "core.xtm"))) - (let - ((association (make-construct 'AssociationC - :start-revision start-revision - :instance-of type - :themes themes - :roles roles))) - (add-to-topicmap tm association) - (set-reifier-xtm1.0 assoc-elem association) - (map 'list #'(lambda(assoc-role) - (map 'list #'(lambda(list-role) - (when (and (eql (instance-of assoc-role) - (getf list-role :instance-of)) - (eql (player assoc-role) - (getf list-role :player)) - (getf list-role :reifier-uri)) - (let ((reifier-uri (getf list-role :reifier-uri))) - (when (and (stringp reifier-uri) - (> (length reifier-uri) 0)) - (let ((psi - (elephant:get-instance-by-value 'd:PersistentIdC 'd:uri - reifier-uri))) - (when psi - (let ((reifier-topic (identified-construct psi))) - (when reifier-topic - (add-reifier assoc-role reifier-topic))))))))) - roles)) - (roles association)) - association)))) + (add-to-topicmap tm + (make-construct 'AssociationC + :start-revision start-revision + :instance-of type + :themes themes + :reifier reifier-topic + :roles roles))))) + (defun set-standard-role-types (roles) Modified: trunk/src/xml/xtm/importer_xtm2.0.lisp ============================================================================== --- trunk/src/xml/xtm/importer_xtm2.0.lisp (original) +++ trunk/src/xml/xtm/importer_xtm2.0.lisp Fri Dec 11 19:29:01 2009 @@ -9,12 +9,11 @@ (in-package :xml-importer) -(defun set-reifier (reifiable-elem reifiable-construct) - "Sets the reifier-topic of the passed elem to the passed construct." +(defun get-reifier-topic(reifiable-elem) + "Returns the reifier topic of the reifierable-element or nil." (declare (dom:element reifiable-elem)) - (declare (ReifiableConstructC reifiable-construct)) (let ((reifier-uri (get-attribute reifiable-elem "reifier")) - (err "From set-reifier(): ")) + (err "From get-reifier-topic(): ")) (when (and (stringp reifier-uri) (> (length reifier-uri) 0)) (let ((ii @@ -22,10 +21,9 @@ (if ii (let ((reifier-topic (identified-construct ii))) (if reifier-topic - (add-reifier reifiable-construct reifier-topic) + reifier-topic (error "~aitem-identifier ~a not found" err reifier-uri))) - (error "~aitem-identifier ~a not found" err reifier-uri))))) - reifiable-construct) + (error "~aitem-identifier ~a not found" err reifier-uri)))))) (defun from-identifier-elem (classsymbol elem start-revision) @@ -35,15 +33,10 @@ (declare (symbol classsymbol)) (declare (dom:element elem)) (declare (integer start-revision)) - -;; (make-construct classsymbol -;; :uri (get-attribute elem "href") -;; :start-revision start-revision)) (let ((id (make-instance classsymbol :uri (get-attribute elem "href") :start-revision start-revision))) - ;(add-to-version-history id :start-revision start-revision) id)) @@ -133,7 +126,8 @@ (instance-of (from-type-elem (xpath-single-child-elem-by-qname name-elem - *xtm2.0-ns* "type") :xtm-id xtm-id))) + *xtm2.0-ns* "type") :xtm-id xtm-id)) + (reifier-topic (get-reifier-topic name-elem))) (unless namevalue (error "A name must have exactly one namevalue")) @@ -143,10 +137,11 @@ :charvalue namevalue :instance-of instance-of :item-identifiers item-identifiers + :reifier reifier-topic :themes themes))) (loop for variant-elem across (xpath-child-elems-by-qname name-elem *xtm2.0-ns* "variant") do (from-variant-elem variant-elem name start-revision :xtm-id xtm-id)) - (set-reifier name-elem name)))) + name))) (defun from-resourceX-elem (parent-elem) @@ -195,18 +190,19 @@ (themes (append (from-scope-elem (xpath-single-child-elem-by-qname variant-elem *xtm2.0-ns* "scope") :xtm-id xtm-id) (themes name))) - (variant-value (from-resourceX-elem variant-elem))) + (variant-value (from-resourceX-elem variant-elem)) + (reifier-topic (get-reifier-topic variant-elem))) (unless variant-value (error "VariantC: one of resourceRef and resourceData must be set")) - (let ((variant (make-construct 'VariantC - :start-revision start-revision - :item-identifiers item-identifiers - :themes themes - :charvalue (getf variant-value :data) - :datatype (getf variant-value :type) - :name name))) - (set-reifier variant-elem variant)))) + (make-construct 'VariantC + :start-revision start-revision + :item-identifiers item-identifiers + :themes themes + :charvalue (getf variant-value :data) + :datatype (getf variant-value :type) + :reifier reifier-topic + :name name))) (defun from-occurrence-elem (occ-elem top start-revision &key (xtm-id *current-xtm*)) @@ -228,18 +224,19 @@ (from-type-elem (xpath-single-child-elem-by-qname occ-elem *xtm2.0-ns* "type") :xtm-id xtm-id)) - (occurrence-value (from-resourceX-elem occ-elem))) + (occurrence-value (from-resourceX-elem occ-elem)) + (reifier-topic (get-reifier-topic occ-elem))) (unless occurrence-value (error "OccurrenceC: one of resourceRef and resourceData must be set")) - (let ((occurrence (make-construct 'OccurrenceC - :start-revision start-revision - :topic top - :themes themes - :item-identifiers item-identifiers - :instance-of instance-of - :charvalue (getf occurrence-value :data) - :datatype (getf occurrence-value :type)))) - (set-reifier occ-elem occurrence)))) + (make-construct 'OccurrenceC + :start-revision start-revision + :topic top + :themes themes + :item-identifiers item-identifiers + :instance-of instance-of + :charvalue (getf occurrence-value :data) + :reifier reifier-topic + :datatype (getf occurrence-value :type)))) @@ -344,21 +341,14 @@ role-elem *xtm2.0-ns* "topicRef")) :xtm-id xtm-id)) - (reifier-uri - (let ((value (get-attribute role-elem "reifier"))) - (if (and (stringp value) - (> (length value) 0)) - value - nil)))) -; (unless (and player instance-of) -; (error "Role in association not complete")) + (reifier-topic (get-reifier-topic role-elem))) (unless player ;instance-of will be set later - if there is no one (error "Role in association with topicref ~a not complete" (get-topicref-uri (xpath-single-child-elem-by-qname role-elem *xtm2.0-ns* "topicRef")))) - (list :reifier-uri reifier-uri + (list :reifier reifier-topic :instance-of instance-of :player player :item-identifiers item-identifiers)))) @@ -375,8 +365,7 @@ (declare (TopicMapC tm)) (elephant:ensure-transaction (:txn-nosync t) (let - ((err "From from-association-elem(): ") - (item-identifiers + ((item-identifiers (make-identifiers 'ItemIdentifierC assoc-elem "itemIdentity" start-revision)) (instance-of (from-type-elem @@ -395,40 +384,18 @@ (from-role-elem role-elem start-revision :xtm-id xtm-id)) (xpath-child-elems-by-qname assoc-elem - *xtm2.0-ns* "role")))) + *xtm2.0-ns* "role"))) + (reifier-topic (get-reifier-topic assoc-elem))) (setf roles (set-standard-role-types roles)); sets standard role types if there are missing some of them - (let ((assoc (add-to-topicmap - tm - (make-construct 'AssociationC - :start-revision start-revision - :item-identifiers item-identifiers - :instance-of instance-of - :themes themes - :roles roles)))) - (map 'list #'(lambda(assoc-role) - (map 'list #'(lambda(list-role) - (when (and (eql (instance-of assoc-role) - (getf list-role :instance-of)) - (eql (player assoc-role) - (getf list-role :player)) - (getf list-role :reifier-uri)) - (let ((reifier-uri (getf list-role :reifier-uri))) - (when (and (stringp reifier-uri) - (> (length reifier-uri) 0)) - (let ((ii - (elephant:get-instance-by-value 'd:ItemIdentifierC 'd:uri - reifier-uri))) - (if ii - (let ((reifier-topic (identified-construct ii))) - (if reifier-topic - (add-reifier assoc-role reifier-topic) - (error "~aitem-identifier ~a not found" err reifier-uri))) - (error "~aitem-identifier ~a not found" err reifier-uri))))))) - roles)) - (roles assoc)) - (set-reifier assoc-elem assoc))))) - - + (add-to-topicmap + tm + (make-construct 'AssociationC + :start-revision start-revision + :item-identifiers item-identifiers + :instance-of instance-of + :themes themes + :reifier reifier-topic + :roles roles))))) (defun get-topic-elems (xtm-dom) (xpath-child-elems-by-qname xtm-dom

1 0

[isidorus-cvs] r171 - trunk/src/unit_tests
by Lukas Giessmann 11 Dec '09

11 Dec '09

Author: lgiessmann Date: Fri Dec 11 18:37:41 2009 New Revision: 171 Log: adapted some unit-tests to the fixed ticket #50 --> core_psis.xtm Modified: trunk/src/unit_tests/exporter_xtm2.0_test.lisp trunk/src/unit_tests/importer_test.lisp trunk/src/unit_tests/json_test.lisp Modified: trunk/src/unit_tests/exporter_xtm2.0_test.lisp ============================================================================== --- trunk/src/unit_tests/exporter_xtm2.0_test.lisp (original) +++ trunk/src/unit_tests/exporter_xtm2.0_test.lisp Fri Dec 11 18:37:41 2009 @@ -386,9 +386,9 @@ (defvar core-occurrence-psi "http://www.topicmaps.org/xtm/1.0/core.xtm#occurrence") (defvar core-class-instance-psi "http://www.topicmaps.org/xtm/1.0/core.xtm#class-instance") (defvar core-class-psi "http://www.topicmaps.org/xtm/1.0/core.xtm#class") -(defvar core-superclass-subclass-psi "http://www.topicmaps.org/xtm/1.0/core.xtm#superclass-subclass") -(defvar core-superclass-psi "http://www.topicmaps.org/xtm/1.0/core.xtm#superclass") -(defvar core-subclass-psi "http://www.topicmaps.org/xtm/1.0/core.xtm#subclass") +(defvar core-superclass-subclass-psi "http://www.topicmaps.org/xtm/1.0/core.xtm#supertype-subtype") +(defvar core-superclass-psi "http://www.topicmaps.org/xtm/1.0/core.xtm#supertype") +(defvar core-subclass-psi "http://www.topicmaps.org/xtm/1.0/core.xtm#subtype") (defvar core-sort-psi "http://www.topicmaps.org/xtm/1.0/core.xtm#sort") (defvar core-display-psi "http://www.topicmaps.org/xtm/1.0/core.xtm#display") (defvar core-type-instance-psi "http://psi.topicmaps.org/iso13250/model/type-instance") Modified: trunk/src/unit_tests/importer_test.lisp ============================================================================== --- trunk/src/unit_tests/importer_test.lisp (original) +++ trunk/src/unit_tests/importer_test.lisp Fri Dec 11 18:37:41 2009 @@ -197,7 +197,7 @@ (top-t301 (get-item-by-id "t301")) (top-t301a (get-item-by-id "t301a")) ;one of the core PSIs - (top-sup-sub (get-item-by-id "superclass-subclass" :xtm-id "core.xtm"))) + (top-sup-sub (get-item-by-id "supertype-subtype" :xtm-id "core.xtm"))) (is (= (internal-id top-t301) (internal-id top-t301a))) (is (= (length (occurrences top-t1)) 0)) @@ -210,7 +210,7 @@ (is-true (item-identifiers (first (names top-t301)))) ;after merge (is (= 2 (length (psis top-t301)))) ;after merge (is (= 3 (length (occurrences top-t301)))) ;after merge - (is (string= "http://www.topicmaps.org/xtm/1.0/core.xtm#superclass-subclass" + (is (string= "http://www.topicmaps.org/xtm/1.0/core.xtm#supertype-subtype" (uri (first (psis top-sup-sub))))))) ;34 topics in 35 topic elements in notificationbase.xtm and 13 Modified: trunk/src/unit_tests/json_test.lisp ============================================================================== --- trunk/src/unit_tests/json_test.lisp (original) +++ trunk/src/unit_tests/json_test.lisp Fri Dec 11 18:37:41 2009 @@ -1171,11 +1171,11 @@ (is (= (length topic-psis) 1))) ((string= (first topic-psis) "http://www.topicmaps.org/xtm/1.0/core.xtm#class") (is (= (length topic-psis) 1))) - ((string= (first topic-psis) "http://www.topicmaps.org/xtm/1.0/core.xtm#superclass-subclass") + ((string= (first topic-psis) "http://www.topicmaps.org/xtm/1.0/core.xtm#supertype-subtype") (is (= (length topic-psis) 1))) - ((string= (first topic-psis) "http://www.topicmaps.org/xtm/1.0/core.xtm#superclass") + ((string= (first topic-psis) "http://www.topicmaps.org/xtm/1.0/core.xtm#supertype") (is (= (length topic-psis) 1))) - ((string= (first topic-psis) "http://www.topicmaps.org/xtm/1.0/core.xtm#subclass") + ((string= (first topic-psis) "http://www.topicmaps.org/xtm/1.0/core.xtm#subtype") (is (= (length topic-psis) 1))) ((string= (first topic-psis) "http://www.topicmaps.org/xtm/1.0/core.xtm#sort") (is (= (length topic-psis) 1))) @@ -1254,10 +1254,10 @@ ((string= (first topic-psis) "http://psi.egovpt.org/service/Norwegian+National+Curriculum") (is (= (length topic-psis) 1))) ((or (string= (first topic-psis) "http://psi.egovpt.org/service/Google+Maps") - (string= (first topic-psis) "http://maps.google.com") - (is (= (length topic-psis) 2)) - (is (or (string= (second topic-psis) "http://psi.egovpt.org/service/Google+Maps") - (string= (second topic-psis) "http://maps.google.com"))))) + (string= (first topic-psis) "http://maps.google.com")) + (is (= (length topic-psis) 2)) + (is (or (string= (second topic-psis) "http://psi.egovpt.org/service/Google+Maps") + (string= (second topic-psis) "http://maps.google.com")))) (t (is-true (format t "found bad topic-psis: ~a" topic-psis)))))))))

1 0

[isidorus-cvs] r170 - in trunk/src: model unit_tests xml/xtm
by Lukas Giessmann 10 Dec '09

10 Dec '09

Author: lgiessmann Date: Thu Dec 10 13:23:13 2009 New Revision: 170 Log: fixed ticket #50 --> some unit-test have to be adapted; changed the delete-construct method in the data model --> if a reified construct is deleted the reifier-topic is also deleted Modified: trunk/src/model/datamodel.lisp trunk/src/unit_tests/reification_test.lisp trunk/src/xml/xtm/core_psis.xtm Modified: trunk/src/model/datamodel.lisp ============================================================================== --- trunk/src/model/datamodel.lisp (original) +++ trunk/src/model/datamodel.lisp Thu Dec 10 13:23:13 2009 @@ -642,7 +642,9 @@ (dolist (id (item-identifiers construct)) (delete-construct id)) (when (reifier construct) - (remove-reifier construct))) + (let ((reifier-topic (reifier construct))) + (remove-reifier construct) + (delete-construct reifier-topic)))) (defgeneric item-identifiers-p (constr) (:documentation "Test for the existence of item identifiers") Modified: trunk/src/unit_tests/reification_test.lisp ============================================================================== --- trunk/src/unit_tests/reification_test.lisp (original) +++ trunk/src/unit_tests/reification_test.lisp Thu Dec 10 13:23:13 2009 @@ -296,13 +296,8 @@ 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)))) + (elephant:close-store)))))) (test test-xtm2.0-reification @@ -365,13 +360,8 @@ 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)))) + (elephant:close-store)))))) (test test-xtm1.0-reification-exporter Modified: trunk/src/xml/xtm/core_psis.xtm ============================================================================== --- trunk/src/xml/xtm/core_psis.xtm (original) +++ trunk/src/xml/xtm/core_psis.xtm Thu Dec 10 13:23:13 2009 @@ -51,24 +51,24 @@ </name> </topic> - <topic id="superclass-subclass"> - <subjectIdentifier href="http://www.topicmaps.org/xtm/1.0/core.xtm#superclass-subclass"/> + <topic id="supertype-subtype"> + <subjectIdentifier href="http://www.topicmaps.org/xtm/1.0/core.xtm#supertype-subtype"/> <name> - <value>superclass-subclass</value> + <value>supertype-subtype</value> </name> </topic> - <topic id="superclass"> - <subjectIdentifier href="http://www.topicmaps.org/xtm/1.0/core.xtm#superclass"/> + <topic id="supertype"> + <subjectIdentifier href="http://www.topicmaps.org/xtm/1.0/core.xtm#supertype"/> <name> - <value>superclass</value> + <value>supertype</value> </name> </topic> - <topic id="subclass"> - <subjectIdentifier href="http://www.topicmaps.org/xtm/1.0/core.xtm#subclass"/> + <topic id="subtype"> + <subjectIdentifier href="http://www.topicmaps.org/xtm/1.0/core.xtm#subtype"/> <name> - <value>subclass</value> + <value>subtype</value> </name> </topic>

1 0

[isidorus-cvs] r169 - trunk/src/model
by Lukas Giessmann 10 Dec '09

10 Dec '09

Author: lgiessmann Date: Thu Dec 10 09:53:34 2009 New Revision: 169 Log: improved the handling of reifiable-constructs in the data model Modified: trunk/src/model/datamodel.lisp Modified: trunk/src/model/datamodel.lisp ============================================================================== --- trunk/src/model/datamodel.lisp (original) +++ trunk/src/model/datamodel.lisp Thu Dec 10 09:53:34 2009 @@ -634,7 +634,8 @@ (declare (ItemIdentifierC id)) (setf (identified-construct id) instance)) (when reifier - (setf (reifier instance) reifier)) + (add-reifier instance reifier)) + ;(setf (reifier instance) reifier)) instance) (defmethod delete-construct :before ((construct ReifiableConstructC)) @@ -642,7 +643,6 @@ (delete-construct id)) (when (reifier construct) (remove-reifier construct))) - ;(slot-makunbound (reifier construct) 'reified))) (defgeneric item-identifiers-p (constr) (:documentation "Test for the existence of item identifiers")

1 0

[isidorus-cvs] r168 - trunk/src/xml/rdf
by Lukas Giessmann 10 Dec '09

10 Dec '09

Author: lgiessmann Date: Thu Dec 10 09:44:47 2009 New Revision: 168 Log: all topic-stubs of a fragment are exported explicitely if they do own more than one psi or another identifier Modified: trunk/src/xml/rdf/exporter.lisp Modified: trunk/src/xml/rdf/exporter.lisp ============================================================================== --- trunk/src/xml/rdf/exporter.lisp (original) +++ trunk/src/xml/rdf/exporter.lisp Thu Dec 10 09:44:47 2009 @@ -569,7 +569,13 @@ (defmethod to-rdf-elem ((construct FragmentC)) "Exports TM-Fragments as RDF/XML data." (topic-to-rdf-elem (topic construct)) - ;all stubs are exported implicitely by references of the topic or associations + (map 'list #'(lambda(top) + (when (or (> (length (psis top)) 1) + (item-identifiers top) + (locators top)) + (topic-to-rdf-stub-elem top))) + (referenced-topics construct)) + ;all other stubs are exported implicitely by references of the main topic or associations (map 'list #'to-rdf-elem (intersection (list-tm-associations) (associations construct)))) @@ -612,6 +618,26 @@ (union t-occs t-assocs)))))) +(defun topic-to-rdf-stub-elem (construct) + "Exports a topic as a stub." + (declare (TopicC construct)) + (cxml:with-element "rdf:Description" + (let ((psi (get-reifier-psi construct)) + (ii (item-identifiers construct)) + (sl (locators construct))) + (if psi + (if (reified construct) + (let ((reifier-uri (get-reifier-uri construct))) + (if reifier-uri + (cxml:attribute "rdf:about" (concatenate 'string "#" (get-reifier-uri construct))) + (cxml:attribute "rdf:about" (uri psi)))) + (cxml:attribute "rdf:about" (uri psi))) + (cxml:attribute "rdf:nodeID" (make-object-id construct))) + (map 'list #'to-rdf-elem (remove psi (psis construct))) + (map 'list #'to-rdf-elem sl) + (map 'list #'to-rdf-elem ii)))) + + (defgeneric to-rdf-string (construct) (:documentation "Prints the string representation of a Fragment element as RDF/XML"))

1 0

[isidorus-cvs] r167 - in trunk/src: rest_interface unit_tests xml/rdf
by Lukas Giessmann 10 Dec '09

10 Dec '09

Author: lgiessmann Date: Thu Dec 10 08:00:55 2009 New Revision: 167 Log: added a restful handler that is able to export TM-Fragments as RDF/XML Modified: trunk/src/rest_interface/set-up-json-interface.lisp trunk/src/unit_tests/reification_test.lisp trunk/src/xml/rdf/exporter.lisp Modified: trunk/src/rest_interface/set-up-json-interface.lisp ============================================================================== --- trunk/src/rest_interface/set-up-json-interface.lisp (original) +++ trunk/src/rest_interface/set-up-json-interface.lisp Thu Dec 10 08:00:55 2009 @@ -9,7 +9,8 @@ (in-package :rest-interface) -(defparameter *json-get-prefix* "/json/get/(.+)$") ;the prefix to get a fragment by the psis -> localhost:8000/json/get/<fragment-psi> +(defparameter *json-get-prefix* "/json/get/(.+)$") ;the prefix to get a fragment by the psi -> localhost:8000/json/get/<fragment-psi> +(defparameter *json-get-rdf-prefix* "/json/get/rdf/(.+)$") ;the prefix to get a fragment by the psi -> localhost:8000/json/rdf/get/<fragment-psi> (defparameter *json-commit-url* "/json/commit/?$") ;the url to commit a json fragment by "put" or "post" (defparameter *json-get-all-psis* "/json/psis/?$") ;the url to get all topic psis of isidorus -> localhost:8000/json/psis (defparameter *json-get-summary-url* "/json/summary/?$") ;the url to get a summary of all topic stored in isidorus; you have to set the GET-parameter "start" for the start index of all topics within elephant and the GET-paramter "end" for the last index of the topic sequence -> http://localhost:8000/json/summary/?start=12&end=13 @@ -27,6 +28,7 @@ (defparameter *ajax-javascript-url-prefix* "/javascripts") ; the url prefix of all javascript files (defun set-up-json-interface (&key (json-get-prefix *json-get-prefix*) + (json-get-rdf-prefix *json-get-rdf-prefix*) (json-get-all-psis *json-get-all-psis*) (json-commit-url *json-commit-url*) (json-get-summary-url *json-get-summary-url*) @@ -80,6 +82,9 @@ (create-regex-dispatcher json-get-prefix #'return-json-fragment) hunchentoot:*dispatch-table*) (push + (create-regex-dispatcher json-get-rdf-prefix #'return-json-rdf-fragment) + hunchentoot:*dispatch-table*) + (push (create-regex-dispatcher json-get-topic-stub-prefix #'return-topic-stub-of-psi) hunchentoot:*dispatch-table*) (push @@ -238,6 +243,31 @@ (setf (hunchentoot:return-code*) hunchentoot:+http-bad-request+)))) +(defun return-json-rdf-fragment(&optional psi) + "returns the json-fragmen belonging to the psi passed by the parameter psi" + (assert psi) + (let ((http-method (hunchentoot:request-method*))) + (if (eq http-method :GET) + (let ((identifier (string-replace psi "%23" "#"))) + (setf (hunchentoot:content-type*) "application/json") ;RFC 4627 + (let ((fragment + (with-writer-lock + (create-latest-fragment-of-topic identifier)))) + (if fragment + (handler-case (with-reader-lock + (rdf-exporter:to-rdf-string fragment)) + (condition (err) + (progn + (setf (hunchentoot:return-code*) hunchentoot:+http-internal-server-error+) + (setf (hunchentoot:content-type*) "text") + (format nil "Condition: \"~a\"" err)))) + (progn + (setf (hunchentoot:return-code*) hunchentoot:+http-not-found+) + (setf (hunchentoot:content-type*) "text") + (format nil "Topic \"~a\" not found" psi))))) + (setf (hunchentoot:return-code*) hunchentoot:+http-bad-request+)))) + + (defun json-commit(&optional param) "calls the json-to-elem method for a json-fragment and imports it to elephant" (declare (ignorable param)) ;param is currently not used Modified: trunk/src/unit_tests/reification_test.lisp ============================================================================== --- trunk/src/unit_tests/reification_test.lisp (original) +++ trunk/src/unit_tests/reification_test.lisp Thu Dec 10 08:00:55 2009 @@ -1005,11 +1005,6 @@ (elephant:close-store)) -;;TODO: check merge-reifier-topics (--> versioning) -;;TODO: extend the fragment-importer in the RESTful-interface -;;TODO: DOKU - - (defun run-reification-tests () (it.bese.fiveam:run! 'test-merge-reifier-topics) (it.bese.fiveam:run! 'test-xtm1.0-reification) Modified: trunk/src/xml/rdf/exporter.lisp ============================================================================== --- trunk/src/xml/rdf/exporter.lisp (original) +++ trunk/src/xml/rdf/exporter.lisp Thu Dec 10 08:00:55 2009 @@ -31,7 +31,8 @@ (:import-from :isidorus-threading with-reader-lock with-writer-lock) - (:export :export-rdf)) + (:export :export-rdf + :to-rdf-string)) (in-package :rdf-exporter) @@ -356,39 +357,7 @@ (xml-lang-p construct))) nil ;; do not export this topic explicitly, since it has been exported as ;; rdf:resource, property or any other reference - (cxml:with-element "rdf:Description" - (let ((psi (get-reifier-psi construct)) - (ii (item-identifiers construct)) - (sl (locators construct)) - (t-names (names construct)) - (t-occs (occurrences construct)) - (t-assocs (list-rdf-mapped-associations construct))) - (if psi - (if (reified construct) - (let ((reifier-uri (get-reifier-uri construct))) - (if reifier-uri - (cxml:attribute "rdf:about" (concatenate 'string "#" (get-reifier-uri construct))) - (cxml:attribute "rdf:about" (uri psi)))) - (cxml:attribute "rdf:about" (uri psi))) - (cxml:attribute "rdf:nodeID" (make-object-id construct))) - (when (or (> (length (psis construct)) 1) - ii sl t-names - (isi-occurrence-p construct)) - (make-isi-type *tm2rdf-topic-type-uri*)) - (map 'list #'to-rdf-elem (remove psi (psis construct))) - (map 'list #'to-rdf-elem sl) - (map 'list #'to-rdf-elem ii) - (map 'list #'(lambda(x) - (cxml:with-element "rdf:type" - (make-topic-reference x))) - (list-instanceOf construct)) - (map 'list #'(lambda(x) - (cxml:with-element "rdfs:subClassOf" - (make-topic-reference x))) - (list-super-types construct)) - (map 'list #'to-rdf-elem t-names) - (map 'list #'to-rdf-elem (sort-constructs - (union t-occs t-assocs))))))) + (topic-to-rdf-elem construct))) (defun sort-constructs (constructs) @@ -594,4 +563,86 @@ (< slash-position (- (length (uri psi)) 1)))) psi nil))) - (psis topic))) \ No newline at end of file + (psis topic))) + + +(defmethod to-rdf-elem ((construct FragmentC)) + "Exports TM-Fragments as RDF/XML data." + (topic-to-rdf-elem (topic construct)) + ;all stubs are exported implicitely by references of the topic or associations + (map 'list #'to-rdf-elem (intersection (list-tm-associations) (associations construct)))) + + +(defun topic-to-rdf-elem (construct) + "Creates a node that describes a TM topic. The passed topic is exported + explicitely, although it was exported as a resource-reference." + (declare (TopicC construct)) + (cxml:with-element "rdf:Description" + (let ((psi (get-reifier-psi construct)) + (ii (item-identifiers construct)) + (sl (locators construct)) + (t-names (names construct)) + (t-occs (occurrences construct)) + (t-assocs (list-rdf-mapped-associations construct))) + (if psi + (if (reified construct) + (let ((reifier-uri (get-reifier-uri construct))) + (if reifier-uri + (cxml:attribute "rdf:about" (concatenate 'string "#" (get-reifier-uri construct))) + (cxml:attribute "rdf:about" (uri psi)))) + (cxml:attribute "rdf:about" (uri psi))) + (cxml:attribute "rdf:nodeID" (make-object-id construct))) + (when (or (> (length (psis construct)) 1) + ii sl t-names + (isi-occurrence-p construct)) + (make-isi-type *tm2rdf-topic-type-uri*)) + (map 'list #'to-rdf-elem (remove psi (psis construct))) + (map 'list #'to-rdf-elem sl) + (map 'list #'to-rdf-elem ii) + (map 'list #'(lambda(x) + (cxml:with-element "rdf:type" + (make-topic-reference x))) + (list-instanceOf construct)) + (map 'list #'(lambda(x) + (cxml:with-element "rdfs:subClassOf" + (make-topic-reference x))) + (list-super-types construct)) + (map 'list #'to-rdf-elem t-names) + (map 'list #'to-rdf-elem (sort-constructs + (union t-occs t-assocs)))))) + + +(defgeneric to-rdf-string (construct) + (:documentation "Prints the string representation of a Fragment element as RDF/XML")) + + +(defmethod to-rdf-string ((construct FragmentC)) + "Exports a FragmentC object as a string in RDF/XML representation." + (init-*ns-map*) + (let ((str + (cxml:with-xml-output (cxml:make-string-sink :indentation 2 :canonical nil) + (cxml:with-namespace ("isi" *tm2rdf-ns*) + (cxml:with-namespace ("rdf" *rdf-ns*) + (cxml:with-namespace ("rdfs" *rdfs-ns*) + (cxml:with-namespace ("xml" *xml-ns*) + (cxml:with-element "rdf:RDF" + (to-rdf-elem construct))))))))) + (setf *ns-map* nil) + str)) + + +(defmethod to-rdf-string ((construct TopicMapConstructC)) + "Exports a TopicMapConstructC object as a string in RDF/XML representation." + (init-*ns-map*) + (let ((str + (cxml:with-xml-output (cxml:make-string-sink :indentation 2 :canonical nil) + (cxml:with-namespace ("isi" *tm2rdf-ns*) + (cxml:with-namespace ("rdf" *rdf-ns*) + (cxml:with-namespace ("rdfs" *rdfs-ns*) + (cxml:with-namespace ("xml" *xml-ns*) + (cxml:with-element "rdf:RDF" + (to-rdf-elem construct))))))))) + (setf *ns-map* nil) + str)) + +

1 0

[isidorus-cvs] r166 - in trunk/src: model unit_tests
by Lukas Giessmann 08 Dec '09

08 Dec '09

Author: lgiessmann Date: Tue Dec 8 10:46:52 2009 New Revision: 166 Log: all reifiers of a fragment\'s topic are collected now as referenced-topics Modified: trunk/src/model/changes.lisp trunk/src/unit_tests/reification_test.lisp Modified: trunk/src/model/changes.lisp ============================================================================== --- trunk/src/model/changes.lisp (original) +++ trunk/src/model/changes.lisp Tue Dec 8 10:46:52 2009 @@ -57,6 +57,8 @@ (defmethod find-referenced-topics ((characteristic CharacteristicC)) "characteristics are scopable + typable" (append + (when (reifier characteristic) + (list (reifier characteristic))) (themes characteristic) (when (instance-of-p characteristic) (list (instance-of characteristic))) @@ -68,12 +70,16 @@ (defmethod find-referenced-topics ((role RoleC)) (append + (when (reifier role) + (list (reifier role))) (list (instance-of role)) (list (player role)))) (defmethod find-referenced-topics ((association AssociationC)) "associations are scopable + typable" (append + (when (reifier association) + (list (reifier association))) (list (instance-of association)) (themes association) (mapcan #'find-referenced-topics (roles association)))) Modified: trunk/src/unit_tests/reification_test.lisp ============================================================================== --- trunk/src/unit_tests/reification_test.lisp (original) +++ trunk/src/unit_tests/reification_test.lisp Tue Dec 8 10:46:52 2009 @@ -44,7 +44,8 @@ :test-rdf-exporter-reification :test-rdf-exporter-reification-2 :test-rdf-exporter-reification-3 - :test-rdf-exporter-reification-4)) + :test-rdf-exporter-reification-4 + :test-fragment-reification)) (in-package :reification-test) @@ -969,8 +970,42 @@ (elephant:close-store)) +(test test-fragment-reification + "Tests the reification in the rdf-exporter." + (let + ((dir "data_base") + (output-file "__out__.rdf") + (tm-id "http://simpsons.tv")) + (handler-case (delete-file output-file) + (error () )) ;do nothing + (clean-out-db dir) + (rdf-importer:rdf-importer *reification.rdf* dir + :tm-id tm-id + :document-id "reification-xtm") + (elephant:open-store (xml-importer:get-store-spec dir)) + (let ((fragment (d:create-latest-fragment-of-topic "http://simpsons.tv/lisa"))) + (is-true fragment) + (is (= (length (union (referenced-topics fragment) + (list (d:get-item-by-psi "http://simpsons.tv/lastName") + (d:get-item-by-psi "http://simpsons.tv/sortName") + (d:get-item-by-psi "http://simpsons.tv/profession") + (d:get-item-by-psi "http://simpsons.tv/lisa-name") + (d:get-item-by-psi "http://simpsons.tv/lisa-name-variant") + (d:get-item-by-psi "http://simpsons.tv/lisa-occurrence")))) + 6))) + (let ((fragment (d:create-latest-fragment-of-topic "http://simpsons.tv/carl"))) + (is-true fragment) + (is (= (length (union (referenced-topics fragment) + (list (d:get-item-by-psi "http://simpsons.tv/friendship") + (d:get-item-by-psi "http://simpsons.tv/friendship-association") + (d:get-item-by-psi "http://simpsons.tv/friend") + (d:get-item-by-psi "http://simpsons.tv/lenny") + (d:get-item-by-psi "http://simpsons.tv/friend-role")))) + 5)))) + (elephant:close-store)) + + ;;TODO: check merge-reifier-topics (--> versioning) -;;TODO: check fragment exporter ;;TODO: extend the fragment-importer in the RESTful-interface ;;TODO: DOKU @@ -988,4 +1023,5 @@ (it.bese.fiveam:run! 'test-rdf-exporter-reification) (it.bese.fiveam:run! 'test-rdf-exporter-reification-2) (it.bese.fiveam:run! 'test-rdf-exporter-reification-3) - (it.bese.fiveam:run! 'test-rdf-exporter-reification-4)) \ No newline at end of file + (it.bese.fiveam:run! 'test-rdf-exporter-reification-4) + (it.bese.fiveam:run! 'test-fragment-reification)) \ No newline at end of file

1 0

[isidorus-cvs] r165 - trunk/src/unit_tests
by Lukas Giessmann 07 Dec '09

07 Dec '09

Author: lgiessmann Date: Mon Dec 7 11:09:02 2009 New Revision: 165 Log: finalized the rdf-exporter-reification unit-tests 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 Dec 7 11:09:02 2009 @@ -42,7 +42,9 @@ :test-rdf-importer-reification-3 :test-rdf-importer-reification-4 :test-rdf-exporter-reification - :test-rdf-exporter-reification-2)) + :test-rdf-exporter-reification-2 + :test-rdf-exporter-reification-3 + :test-rdf-exporter-reification-4)) (in-package :reification-test) @@ -831,16 +833,145 @@ (let ((document (dom:document-element (cxml:parse-file output-file (cxml-dom:make-dom-builder))))) - ) + (let ((lisa + (loop for resource across (xpath-child-elems-by-qname document *rdf-ns* "Description") + when (let ((about (dom:get-attribute-ns resource *rdf-ns* "about"))) + (and (stringp about) (string= about "http://simpsons.tv/lisa"))) + return resource))) + (is-true lisa) + (let ((lisa-name + (let ((arc + (xpath-single-child-elem-by-qname lisa "http://isidorus/tm2rdf_mapping/" "name"))) + (when arc + (xpath-single-child-elem-by-qname arc *rdf-ns* "Description")))) + (lisa-occurrence + (xpath-single-child-elem-by-qname lisa "http://simpsons.tv/" "profession"))) + (is-true lisa-name) + (is-true lisa-occurrence) + (let ((lisa-name-variant + (let ((arc + (xpath-single-child-elem-by-qname lisa-name "http://isidorus/tm2rdf_mapping/" "variant"))) + (when arc + (xpath-single-child-elem-by-qname arc *rdf-ns* "Description"))))) + (is-true lisa-name-variant) + (let ((name-reifier + (let ((elem + (xpath-single-child-elem-by-qname + lisa-name "http://isidorus/tm2rdf_mapping/" "reifier"))) + (when elem + (dom:get-attribute-ns elem *rdf-ns* "resource")))) + (variant-reifier + (let ((elem + (xpath-single-child-elem-by-qname + lisa-name-variant "http://isidorus/tm2rdf_mapping/" "reifier"))) + (when elem + (dom:get-attribute-ns elem *rdf-ns* "resource")))) + (occurrence-reifier (dom:get-attribute-ns lisa-occurrence *rdf-ns* "ID"))) + (is (and (stringp name-reifier) + (string= name-reifier "lisa-name"))) + (is (and (stringp variant-reifier) + (string= variant-reifier "lisa-name-variant"))) + (is (and (stringp occurrence-reifier) + (string= occurrence-reifier "lisa-occurrence")))))))) (handler-case (delete-file output-file) (error () ))) ;do nothing (elephant:close-store)) -;;TODO: check rdf exporter + +(test test-rdf-exporter-reification-3 + "Tests the reification in the rdf-exporter." + (let + ((dir "data_base") + (output-file "__out__.rdf") + (tm-id "http://simpsons.tv")) + (handler-case (delete-file output-file) + (error () )) ;do nothing + (clean-out-db dir) + (rdf-importer:rdf-importer *reification.rdf* dir + :tm-id tm-id + :document-id "reification-xtm") + (elephant:open-store (xml-importer:get-store-spec dir)) + (rdf-exporter:export-rdf output-file :tm-id tm-id) + (let ((document + (dom:document-element + (cxml:parse-file output-file (cxml-dom:make-dom-builder))))) + (let ((homer + (loop for resource across (xpath-child-elems-by-qname document *rdf-ns* "Description") + when (let ((about (dom:get-attribute-ns resource *rdf-ns* "about"))) + (and (stringp about) (string= about "http://simpsons.tv/homer"))) + return resource))) + (is-true homer) + (let ((married-arc + (xpath-single-child-elem-by-qname homer "http://simpsons.tv/arcs/" "married"))) + (is-true married-arc) + (let ((reifier-id (dom:get-attribute-ns married-arc *rdf-ns* "ID"))) + (is (and (stringp reifier-id) + (string= reifier-id "married-arc"))))))) + (handler-case (delete-file output-file) + (error () ))) ;do nothing + (elephant:close-store)) + + +(test test-rdf-exporter-reification-4 + "Tests the reification in the rdf-exporter." + (let + ((dir "data_base") + (output-file "__out__.rdf") + (tm-id "http://simpsons.tv")) + (handler-case (delete-file output-file) + (error () )) ;do nothing + (clean-out-db dir) + (rdf-importer:rdf-importer *reification.rdf* dir + :tm-id tm-id + :document-id "reification-xtm") + (elephant:open-store (xml-importer:get-store-spec dir)) + (rdf-exporter:export-rdf output-file :tm-id tm-id) + (let ((document + (dom:document-element + (cxml:parse-file output-file (cxml-dom:make-dom-builder))))) + (let ((association + (loop for resource across (xpath-child-elems-by-qname document *rdf-ns* "Description") + when (let ((type (xpath-single-child-elem-by-qname resource *rdf-ns* "type"))) + (when type + (let ((type-uri + (dom:get-attribute-ns type *rdf-ns* "resource"))) + (and (stringp type-uri) + (string= type-uri "http://isidorus/tm2rdf_mapping/types/Association"))))) + return resource))) + (is-true association) + (let ((role + (loop for resource across + (xpath-child-elems-by-qname association "http://isidorus/tm2rdf_mapping/" "role") + when (let ((description (xpath-single-child-elem-by-qname resource *rdf-ns* "Description"))) + (when description + (xpath-single-child-elem-by-qname + description "http://isidorus/tm2rdf_mapping/" "reifier"))) + return (xpath-single-child-elem-by-qname resource *rdf-ns* "Description")))) + (is-true role) + (let ((association-reifier + (let ((elem (xpath-single-child-elem-by-qname + association "http://isidorus/tm2rdf_mapping/" "reifier"))) + (when elem + (dom:get-attribute-ns elem *rdf-ns* "resource")))) + (role-reifier + (let ((elem (xpath-single-child-elem-by-qname + role "http://isidorus/tm2rdf_mapping/" "reifier"))) + (when elem + (dom:get-attribute-ns elem *rdf-ns* "resource"))))) + (is-true association-reifier) + (is-true role-reifier) + (is (and (stringp association-reifier) + (string= association-reifier "friendship-association"))) + (is (and (stringp role-reifier) + (string= role-reifier "friend-role"))))))) + (handler-case (delete-file output-file) + (error () ))) ;do nothing + (elephant:close-store)) + + ;;TODO: check merge-reifier-topics (--> versioning) ;;TODO: check fragment exporter ;;TODO: extend the fragment-importer in the RESTful-interface -;;TODO: Delete the tm2rdf-mapping-constructs --> maybe there is a bug in the map-to-tm-file??? ;;TODO: DOKU @@ -855,4 +986,6 @@ (it.bese.fiveam:run! 'test-rdf-importer-reification-3) (it.bese.fiveam:run! 'test-rdf-importer-reification-4) (it.bese.fiveam:run! 'test-rdf-exporter-reification) - (it.bese.fiveam:run! 'test-rdf-exporter-reification-2)) \ No newline at end of file + (it.bese.fiveam:run! 'test-rdf-exporter-reification-2) + (it.bese.fiveam:run! 'test-rdf-exporter-reification-3) + (it.bese.fiveam:run! 'test-rdf-exporter-reification-4)) \ No newline at end of file

1 0

[isidorus-cvs] r164 - in trunk/src: model unit_tests
by Lukas Giessmann 07 Dec '09

07 Dec '09

Author: lgiessmann Date: Mon Dec 7 09:08:02 2009 New Revision: 164 Log: added some rdf-exporter-reification test-cases Modified: trunk/src/model/datamodel.lisp trunk/src/unit_tests/reification_test.lisp Modified: trunk/src/model/datamodel.lisp ============================================================================== --- trunk/src/model/datamodel.lisp (original) +++ trunk/src/model/datamodel.lisp Mon Dec 7 09:08:02 2009 @@ -1640,7 +1640,7 @@ (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 + (add-association tm 'topics 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) Modified: trunk/src/unit_tests/reification_test.lisp ============================================================================== --- trunk/src/unit_tests/reification_test.lisp (original) +++ trunk/src/unit_tests/reification_test.lisp Mon Dec 7 09:08:02 2009 @@ -41,7 +41,8 @@ :test-rdf-importer-reification-2 :test-rdf-importer-reification-3 :test-rdf-importer-reification-4 - :test-rdf-reification-exporter)) + :test-rdf-exporter-reification + :test-rdf-exporter-reification-2)) (in-package :reification-test) @@ -741,7 +742,7 @@ (elephant:close-store)) -(test test-rdf-reification-exporter +(test test-rdf-exporter-reification "Tests the reification in the rdf-exporter." (let ((dir "data_base") @@ -749,19 +750,91 @@ (tm-id "http://simpsons.tv")) (handler-case (delete-file output-file) (error () )) ;do nothing - (rdf-importer:rdf-importer *reification.rdf* + (clean-out-db dir) + (rdf-importer:rdf-importer *reification.rdf* dir :tm-id tm-id :document-id "reification-xtm") - (rdf-exporter:export-rdf output-file :tm-id tm-id) - (let ((document - (dom:document-element - (cxml:parse-file output-file (cxml-dom:make-dom-builder))))) - )) - (handler-case (delete-file output-file) - (error () )) ;do nothing + (elephant:open-store (xml-importer:get-store-spec dir)) + (rdf-exporter:export-rdf output-file :tm-id tm-id) + (let ((document + (dom:document-element + (cxml:parse-file output-file (cxml-dom:make-dom-builder))))) + (let ((married-arc + (loop for reifier-node across (xpath-child-elems-by-qname document *rdf-ns* "Description") + when (let ((about (dom:get-attribute-ns reifier-node *rdf-ns* "about"))) + (and (stringp about) (string= about "#married-arc"))) + return reifier-node)) + (lastName-arc + (loop for reifier-node across (xpath-child-elems-by-qname document *rdf-ns* "Description") + when (let ((about (dom:get-attribute-ns reifier-node *rdf-ns* "about"))) + (and (stringp about) (string= about "#lastName-arc"))) + return reifier-node)) + (lisa-name + (loop for reifier-node across (xpath-child-elems-by-qname document *rdf-ns* "Description") + when (let ((about (dom:get-attribute-ns reifier-node *rdf-ns* "about"))) + (and (stringp about) (string= about "#lisa-name"))) + return reifier-node)) + (lisa-name-variant + (loop for reifier-node across (xpath-child-elems-by-qname document *rdf-ns* "Description") + when (let ((about (dom:get-attribute-ns reifier-node *rdf-ns* "about"))) + (and (stringp about) (string= about "#lisa-name-variant"))) + return reifier-node)) + (lisa-occurrence + (loop for reifier-node across (xpath-child-elems-by-qname document *rdf-ns* "Description") + when (let ((about (dom:get-attribute-ns reifier-node *rdf-ns* "about"))) + (and (stringp about) (string= about "#lisa-occurrence"))) + return reifier-node)) + (friendship-association + (loop for reifier-node across (xpath-child-elems-by-qname document *rdf-ns* "Description") + when (let ((about (dom:get-attribute-ns reifier-node *rdf-ns* "about"))) + (and (stringp about) (string= about "#friendship-association"))) + return reifier-node)) + (friend-role + (loop for reifier-node across (xpath-child-elems-by-qname document *rdf-ns* "Description") + when (let ((about (dom:get-attribute-ns reifier-node *rdf-ns* "about"))) + (and (stringp about) (string= about "#friend-role"))) + return reifier-node))) + (is-true married-arc) + (is-true lastName-arc) + (is-true lisa-name) + (is-true lisa-name-variant) + (is-true lisa-occurrence) + (is-true friendship-association) + (is-true friend-role) + (dolist (reifier-node (list married-arc lastName-arc lisa-name + lisa-name-variant lisa-occurrence + friendship-association friend-role)) + (let ((author-arc + (xpath-single-child-elem-by-qname reifier-node "http://simpsons.tv/arcs/" "author"))) + (is-true author-arc) + (let ((resource (dom:get-attribute-ns author-arc *rdf-ns* "resource"))) + (is (and (stringp resource) (string= resource "http://some.where/me")))))))) + (handler-case (delete-file output-file) + (error () ))) ;do nothing (elephant:close-store)) +(test test-rdf-exporter-reification-2 + "Tests the reification in the rdf-exporter." + (let + ((dir "data_base") + (output-file "__out__.rdf") + (tm-id "http://simpsons.tv")) + (handler-case (delete-file output-file) + (error () )) ;do nothing + (clean-out-db dir) + (rdf-importer:rdf-importer *reification.rdf* dir + :tm-id tm-id + :document-id "reification-xtm") + (elephant:open-store (xml-importer:get-store-spec dir)) + (rdf-exporter:export-rdf output-file :tm-id tm-id) + (let ((document + (dom:document-element + (cxml:parse-file output-file (cxml-dom:make-dom-builder))))) + ) + (handler-case (delete-file output-file) + (error () ))) ;do nothing + (elephant:close-store)) ;;TODO: check rdf exporter ;;TODO: check merge-reifier-topics (--> versioning) @@ -781,4 +854,5 @@ (it.bese.fiveam:run! 'test-rdf-importer-reification-2) (it.bese.fiveam:run! 'test-rdf-importer-reification-3) (it.bese.fiveam:run! 'test-rdf-importer-reification-4) - (it.bese.fiveam:run! 'test-rdf-reification-exporter)) \ No newline at end of file + (it.bese.fiveam:run! 'test-rdf-exporter-reification) + (it.bese.fiveam:run! 'test-rdf-exporter-reification-2)) \ No newline at end of file

1 0