From lgiessmann at common-lisp.net Tue Dec 1 11:05:47 2009 From: lgiessmann at common-lisp.net (Lukas Giessmann) Date: Tue, 01 Dec 2009 06:05:47 -0500 Subject: [isidorus-cvs] r155 - in trunk/src: model unit_tests xml/rdf Message-ID: Author: lgiessmann Date: Tue Dec 1 06:05:46 2009 New Revision: 155 Log: added the support of reification to the rdf-exporter Modified: trunk/src/model/datamodel.lisp trunk/src/unit_tests/reification_test.lisp trunk/src/xml/rdf/exporter.lisp trunk/src/xml/rdf/map_to_tm.lisp Modified: trunk/src/model/datamodel.lisp ============================================================================== --- trunk/src/model/datamodel.lisp (original) +++ trunk/src/model/datamodel.lisp Tue Dec 1 06:05:46 2009 @@ -104,6 +104,7 @@ :reified :reifier :add-reifier + :remove-reifier :*current-xtm* ;; special variables :*TM-REVISION* @@ -1611,6 +1612,14 @@ construct))) +(defgeneric remove-reifier (construct) + (:method ((construct ReifiableConstructC)) + (let ((reifier-topic (reifier construct))) + (when reifier-topic + (elephant:remove-association construct 'reifier reifier-topic) + (elephant:remove-association reifier-topic 'reified 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)) 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 1 06:05:46 2009 @@ -627,7 +627,6 @@ -;;TODO: check rdf importer ;;TODO: check rdf exporter ;;TODO: check rdf-tm-reification-mapping ;;TODO: check merge-reifier-topics (--> versioning) Modified: trunk/src/xml/rdf/exporter.lisp ============================================================================== --- trunk/src/xml/rdf/exporter.lisp (original) +++ trunk/src/xml/rdf/exporter.lisp Tue Dec 1 06:05:46 2009 @@ -279,9 +279,12 @@ "Creates a blank node that represents a VariantC element with the properties itemIdentity, scope and value." (cxml:with-element "isi:variant" + (when (reifier construct) + (let ((reifier-uri (get-reifier-uri (reifier construct)))) + (when reifier-uri + (cxml:attribute "rdf:ID" reifier-uri)))) (cxml:with-element "rdf:Description" (cxml:attribute "rdf:nodeID" (make-object-id construct)) - ;(cxml:attribute "rdf:parseType" "Resource") (make-isi-type *tm2rdf-variant-type-uri*) (map 'list #'to-rdf-elem (item-identifiers construct)) (scopes-to-rdf-elems construct) @@ -292,7 +295,10 @@ "Creates a blank node that represents a name element with the properties itemIdentity, nametype, value, variant and scope." (cxml:with-element "isi:name" - ;(cxml:attribute "rdf:parseType" "Resource") + (when (reifier construct) + (let ((reifier-uri (get-reifier-uri (reifier construct)))) + (when reifier-uri + (cxml:attribute "rdf:ID" reifier-uri)))) (cxml:with-element "rdf:Description" (cxml:attribute "rdf:nodeID" (make-object-id construct)) (make-isi-type *tm2rdf-name-type-uri*) @@ -319,9 +325,12 @@ (item-identifiers construct) (/= (length (psis (instance-of construct))) 1)) (cxml:with-element "isi:occurrence" + (when (reifier construct) + (let ((reifier-uri (get-reifier-uri (reifier construct)))) + (when reifier-uri + (cxml:attribute "rdf:ID" reifier-uri)))) (cxml:with-element "rdf:Description" (cxml:attribute "rdf:nodeID" (make-object-id construct)) - ;(cxml:attribute "rdf:parseType" "Resource") (make-isi-type *tm2rdf-occurrence-type-uri*) (map 'list #'to-rdf-elem (item-identifiers construct)) (cxml:with-element "isi:occurrencetype" @@ -345,7 +354,8 @@ (occurrences construct))) (or (used-as-type construct) (used-as-theme construct) - (xml-lang-p construct))) + (xml-lang-p construct) + (reified 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" @@ -357,7 +367,12 @@ (t-occs (occurrences construct)) (t-assocs (list-rdf-mapped-associations construct))) (if psi - (cxml:attribute "rdf:about" (uri psi)) + (if (reified construct) + (let ((reifier-uri (get-reifier-uri construct))) + (if reifier-uri + (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 @@ -517,4 +532,35 @@ (eql (instance-of y) isi-subject)) (roles x))))) x)) - (elephant:get-instances-by-class 'AssociationC))))) \ No newline at end of file + (elephant:get-instances-by-class 'AssociationC))))) + + +(defun export-reifier(reifiable-construct) + "Exports the reifier-ID-attribute" + (declare (ReifiableConstructC reifiable-construct)) + (let ((reifier-topic (reifier reifiable-construct))) + (when (and reifier-topic + (psis reifier-topic)) + (let ((reifier-uri (get-reifier-uri reifier-topic))) + (when reifier-uri + (cxml:attribute "rdf:ID" reifier-uri)))))) + + +(defun get-reifier-uri (top) + "Returns the uri that represents the reifier-id of a resource node. + When the topic does not own a psi the return value is nil." + (declare (TopicC top)) + (when (psis top) + (let ((full-uri (uri (first (psis top)))) + (err "From get-reifier-uri(): ")) + (let ((slash-position (find #\/ full-uri :from-end t))) + (let ((hash-position (position #\# full-uri))) + (if (and hash-position + (/= (- (length full-uri) 1) hash-position)) + (subseq full-uri (- hash-position 1)) + (if (and slash-position + (/= (- (length full-uri) 1) slash-position)) + (subseq full-uri (+ 1 slash-position)) + (if (= hash-position (+ (length full-uri) 1)) + (error "~athe PSI-URI ~a ends with an #" err full-uri) + full-uri)))))))) \ No newline at end of file Modified: trunk/src/xml/rdf/map_to_tm.lisp ============================================================================== --- trunk/src/xml/rdf/map_to_tm.lisp (original) +++ trunk/src/xml/rdf/map_to_tm.lisp Tue Dec 1 06:05:46 2009 @@ -64,7 +64,7 @@ (defun delete-instance-of-association(instance-topic type-topic) - "Deletes a type-instance associaiton that corresponds woith the passed + "Deletes a type-instance associaiton that corresponds with the passed parameters." (when (and instance-topic type-topic) (let ((instance (get-item-by-psi *instance-psi*)) From lgiessmann at common-lisp.net Tue Dec 1 12:50:57 2009 From: lgiessmann at common-lisp.net (Lukas Giessmann) Date: Tue, 01 Dec 2009 07:50:57 -0500 Subject: [isidorus-cvs] r156 - in trunk/src: . model xml/rdf Message-ID: Author: lgiessmann Date: Tue Dec 1 07:50:56 2009 New Revision: 156 Log: added a mapping-schema for reification (tm->rdf; rdf->tm) to the rdf-module; unit-tests are currently missing Modified: trunk/src/constants.lisp trunk/src/model/datamodel.lisp trunk/src/xml/rdf/exporter.lisp trunk/src/xml/rdf/map_to_tm.lisp trunk/src/xml/rdf/rdf_tools.lisp Modified: trunk/src/constants.lisp ============================================================================== --- trunk/src/constants.lisp (original) +++ trunk/src/constants.lisp Tue Dec 1 07:50:56 2009 @@ -62,7 +62,8 @@ :*tm2rdf-roletype-property* :*tm2rdf-associationtype-property* :*tm2rdf-player-property* - :*rdf2tm-blank-node-prefix*)) + :*rdf2tm-blank-node-prefix* + :*tm2rdf-association-reifier-property*)) (in-package :constants) @@ -171,3 +172,5 @@ (defparameter *tm2rdf-associationtype-property* (concatenate 'string *tm2rdf-ns* "associationtype")) (defparameter *tm2rdf-player-property* (concatenate 'string *tm2rdf-ns* "player")) + +(defparameter *tm2rdf-association-reifier-property* (concatenate 'string *tm2rdf-ns* "association-reifier")) Modified: trunk/src/model/datamodel.lisp ============================================================================== --- trunk/src/model/datamodel.lisp (original) +++ trunk/src/model/datamodel.lisp Tue Dec 1 07:50:56 2009 @@ -641,7 +641,8 @@ (dolist (id (item-identifiers construct)) (delete-construct id)) (when (reifier construct) - (slot-makunbound (reifier construct) 'reified))) + (remove-reifier construct))) + ;(slot-makunbound (reifier construct) 'reified))) (defgeneric item-identifiers-p (constr) (:documentation "Test for the existence of item identifiers") Modified: trunk/src/xml/rdf/exporter.lisp ============================================================================== --- trunk/src/xml/rdf/exporter.lisp (original) +++ trunk/src/xml/rdf/exporter.lisp Tue Dec 1 07:50:56 2009 @@ -26,7 +26,8 @@ *tm2rdf-occurrence-type-uri* *tm2rdf-topic-type-uri* *tm2rdf-association-type-uri* - *tm2rdf-role-type-uri*) + *tm2rdf-role-type-uri* + *tm2rdf-association-reifier-property*) (:import-from :isidorus-threading with-reader-lock with-writer-lock) @@ -442,6 +443,9 @@ (cxml:with-element "rdf:Description" (cxml:attribute "rdf:nodeID" (make-object-id association)) (make-isi-type *tm2rdf-association-type-uri*) + (when (reifier association) + (cxml:with-element *tm2rdf-association-reifier-property* + (make-topic-reference (reifier association)))) (cxml:with-element "isi:associationtype" (make-topic-reference association-type)) (map 'list #'to-rdf-elem ii) @@ -458,7 +462,9 @@ (cxml:with-element "isi:role" (cxml:with-element "rdf:Description" (cxml:attribute "rdf:nodeID" (make-object-id construct)) - ;(cxml:attribute "rdf:parseType" "Resource") + (when (reifier construct) + (cxml:with-element *tm2rdf-association-reifier-property* + (make-topic-reference (reifier construct)))) (make-isi-type *tm2rdf-role-type-uri*) (map 'list #'to-rdf-elem ii) (cxml:with-element "isi:roletype" @@ -471,7 +477,8 @@ "Exports an TM association as RDF that was imported from RDF. This is indicated by the existence of exactly two roles. One of the type isi:object, the other of the type isi:subject. - Scopes or itemIdentifiers are also forbidden." + Scopes or itemIdentifiers are also forbidden. + If the contained roles own any reifiers they are ignored." (declare (AssociationC association)) (let ((isi-subject (get-item-by-psi *rdf2tm-subject*)) (isi-object (get-item-by-psi *rdf2tm-object*)) @@ -485,6 +492,10 @@ (when (and subject-role object-role (= (length association-roles) 2)) (with-property association + (when (reifier association) + (let ((reifier-uri (get-reifier-uri (reifier association)))) + (when reifier-uri + (cxml:attribute "rdf:ID" reifier-uri)))) (make-topic-reference (player object-role))))))) Modified: trunk/src/xml/rdf/map_to_tm.lisp ============================================================================== --- trunk/src/xml/rdf/map_to_tm.lisp (original) +++ trunk/src/xml/rdf/map_to_tm.lisp Tue Dec 1 07:50:56 2009 @@ -105,14 +105,14 @@ (get-associations-by-type assoc-top start-revision *tm2rdf-role-property* *rdf2tm-subject*))) - (let ((players - (get-players-by-role-type role-assocs start-revision - *rdf2tm-object*))) + (let ((players-and-reifiers + (get-players-and-reifiers-by-role-type + role-assocs start-revision *rdf2tm-object*))) (map 'list #'d::delete-construct role-assocs) - players))) + players-and-reifiers))) -(defun map-isi-role(role-top start-revision) +(defun map-isi-role(role-top reifier-topic start-revision) "Maps a passed topic with all its isidorus:types to a property list representing an association-role." (declare (TopicC role-top)) @@ -144,7 +144,8 @@ (d::delete-construct role-top) (list :instance-of (first types) :player (first role-players) - :item-identifiers ids))))) + :item-identifiers ids + :reifier reifier-topic))))) (defun map-isi-association(assoc-top start-revision tm-id @@ -159,20 +160,28 @@ (get-associations-by-type assoc-top start-revision *tm2rdf-associationtype-property* *rdf2tm-subject*)) + (reifier-assocs + (get-associations-by-type + assoc-top start-revision *tm2rdf-association-reifier-property* + *rdf2tm-subject*)) (scope-assocs (get-associations-by-type assoc-top start-revision *tm2rdf-scope-property* *rdf2tm-subject*)) - (role-tops (get-isi-roles assoc-top start-revision))) + (role-and-reifier-topics (get-isi-roles assoc-top start-revision))) (let ((types (get-players-by-role-type type-assocs start-revision *rdf2tm-object*)) (scopes (get-players-by-role-type scope-assocs start-revision *rdf2tm-object*)) + (reifier-topics (get-players-by-role-type + reifier-assocs start-revision *rdf2tm-object*)) (assoc-roles (remove-if #'null (map 'list - #'(lambda(role-top) - (map-isi-role role-top start-revision)) - role-tops)))) + #'(lambda(role-and-reifier) + (map-isi-role (getf role-and-reifier :player) + (getf role-and-reifier :reifier) + start-revision)) + role-and-reifier-topics)))) (elephant:ensure-transaction (:txn-nosync t) (map 'list #'d::delete-construct type-assocs) (map 'list #'d::delete-construct scope-assocs) @@ -187,12 +196,28 @@ (with-tm (start-revision document-id tm-id) (add-to-topicmap xml-importer::tm - (make-construct 'AssociationC - :start-revision start-revision - :item-identifiers ids - :instance-of (first types) - :themes scopes - :roles assoc-roles))))))) + (let ((association + (make-construct 'AssociationC + :start-revision start-revision + :item-identifiers ids + :instance-of (first types) + :themes scopes + :roles assoc-roles))) + (map 'list #'(lambda(association-role) + (let ((found-item + (find-if #'(lambda(list-item) + (and (eql (instance-of association-role) + (getf list-item :instance-of)) + (eql (player association-role) + (getf list-item :player)) + (getf list-item :reifier))) + assoc-roles))) + (when found-item + (add-reifier association-role (getf found-item :reifier))))) + (roles association)) + (when reifier-topics + (add-reifier association (first reifier-topics))) + association))))))) (defun map-isi-topic(top start-revision) @@ -207,17 +232,21 @@ top start-revision :id-type-uri *tm2rdf-subjectlocator-property*)) (new-item-ids (map-isi-identifiers top start-revision)) - (occurrence-topics (get-isi-occurrences top start-revision)) - (name-topics (get-isi-names top start-revision))) + (occurrence-and-reifier-topics (get-isi-occurrences top start-revision)) + (name-and-reifier-topics (get-isi-names top start-revision))) (bound-subject-identifiers top new-psis) (bound-subject-locators top new-locators) (bound-item-identifiers top new-item-ids) - (map 'list #'(lambda(occ-top) - (map-isi-occurrence top occ-top start-revision)) - occurrence-topics) - (map 'list #'(lambda(name-top) - (map-isi-name top name-top start-revision)) - name-topics)) + (map 'list #'(lambda(occurrence-and-reifier) + (map-isi-occurrence top (getf occurrence-and-reifier :player) + (getf occurrence-and-reifier :reifier) + start-revision)) + occurrence-and-reifier-topics) + (map 'list #'(lambda(name-and-reifier) + (map-isi-name top (getf name-and-reifier :player) + (getf name-and-reifier :reifier) + start-revision)) + name-and-reifier-topics)) top) @@ -229,14 +258,14 @@ (get-associations-by-type name-top start-revision *tm2rdf-variant-property* *rdf2tm-subject*))) - (let ((players - (get-players-by-role-type variant-assocs start-revision - *rdf2tm-object*))) + (let ((players-and-reifiers + (get-players-and-reifiers-by-role-type + variant-assocs start-revision *rdf2tm-object*))) (map 'list #'d::delete-construct variant-assocs) - players))) + players-and-reifiers))) -(defun map-isi-variant (name variant-top start-revision) +(defun map-isi-variant (name variant-top reifier-topic start-revision) "Maps the passed variant-topic to a TM variant." (declare (TopicC variant-top)) (declare (NameC name)) @@ -264,16 +293,19 @@ (map 'list #'d::delete-construct scope-assocs) (delete-related-associations variant-top) (d::delete-construct variant-top) - (make-construct 'VariantC - :start-revision start-revision - :item-identifiers ids - :themes scopes - :charvalue (getf value-and-datatype :value) - :datatype (getf value-and-datatype :datatype) - :name name))))) + (let ((variant + (make-construct 'VariantC + :start-revision start-revision + :item-identifiers ids + :themes scopes + :charvalue (getf value-and-datatype :value) + :datatype (getf value-and-datatype :datatype) + :name name))) + (add-reifier variant reifier-topic) + variant))))) -(defun map-isi-name (top name-top start-revision) +(defun map-isi-name (top name-top reifier-topic start-revision) "Maps the passed occurrence-topic to a TM occurrence." (declare (TopicC top name-top)) (declare (integer start-revision)) @@ -288,8 +320,8 @@ *rdf2tm-subject*)) (value-type-topic (get-item-by-psi *tm2rdf-value-property*)) - (variant-topics (get-isi-variants name-top start-revision))) - (let ((types (let ((fn-types + (variant-and-reifier-topics (get-isi-variants name-top start-revision))) + (let ((type (let ((fn-types (get-players-by-role-type type-assocs start-revision *rdf2tm-object*))) (when fn-types @@ -311,12 +343,15 @@ :start-revision start-revision :topic top :charvalue value - :instance-of types + :instance-of type :item-identifiers ids :themes scopes))) - (map 'list #'(lambda(variant-top) - (map-isi-variant name variant-top start-revision)) - variant-topics) + (add-reifier name reifier-topic) + (map 'list #'(lambda(variant-and-reifier) + (map-isi-variant name (getf variant-and-reifier :player) + (getf variant-and-reifier :reifier) + start-revision)) + variant-and-reifier-topics) (delete-related-associations name-top) (d::delete-construct name-top) name))))) @@ -329,13 +364,14 @@ (let ((assocs (get-associations-by-type top start-revision *tm2rdf-name-property* *rdf2tm-subject*))) - (let ((occ-tops (get-players-by-role-type - assocs start-revision *rdf2tm-object*))) + (let ((name-and-reifier-topics + (get-players-and-reifiers-by-role-type + assocs start-revision *rdf2tm-object*))) (map 'list #'d::delete-construct assocs) - occ-tops))) + name-and-reifier-topics))) -(defun map-isi-occurrence(top occ-top start-revision) +(defun map-isi-occurrence(top occ-top reifier-topic start-revision) "Maps all topics that represents occurrences of the passed topic top to occurrence objects." (declare (TopicC top occ-top)) @@ -374,14 +410,17 @@ err-pref (length types))) (delete-related-associations occ-top) (d::delete-construct occ-top) - (make-construct 'OccurrenceC - :start-revision start-revision - :topic top - :themes scopes - :item-identifiers ids - :instance-of (first types) - :charvalue (getf value-and-datatype :value) - :datatype (getf value-and-datatype :datatype)))))) + (let ((occurrence + (make-construct 'OccurrenceC + :start-revision start-revision + :topic top + :themes scopes + :item-identifiers ids + :instance-of (first types) + :charvalue (getf value-and-datatype :value) + :datatype (getf value-and-datatype :datatype)))) + (add-reifier occurrence reifier-topic) + occurrence))))) (defun get-isi-occurrences(top start-revision) @@ -391,10 +430,11 @@ (let ((assocs (get-associations-by-type top start-revision *tm2rdf-occurrence-property* *rdf2tm-subject*))) - (let ((occ-tops (get-players-by-role-type - assocs start-revision *rdf2tm-object*))) + (let ((occurrences-and-reifiers + (get-players-and-reifiers-by-role-type + assocs start-revision *rdf2tm-object*))) (map 'list #'d::delete-construct assocs) - occ-tops))) + occurrences-and-reifiers))) (defun get-isi-topics (tm-id start-revision @@ -468,6 +508,31 @@ (player role)))) associations)))) players))) + + +(defun get-players-and-reifiers-by-role-type (associations start-revision + role-type-psi) + "Returns tuples of the form (:player :reifier )" + (declare (list associations)) + (declare (integer start-revision)) + (declare (string role-type-psi)) + (let ((role-type (get-item-by-psi role-type-psi + :revision start-revision))) + (let ((tuples + (remove-if + #'null + (map 'list + #'(lambda(assoc) + (let ((role + (find-if #'(lambda(role) + (eql role-type (instance-of role))) + (roles assoc)))) + (when role + (let ((reifier-topic (reifier assoc))) + (list :player (player role) + :reifier reifier-topic))))) + associations)))) + tuples))) (defun get-occurrences-by-type (top start-revision Modified: trunk/src/xml/rdf/rdf_tools.lisp ============================================================================== --- trunk/src/xml/rdf/rdf_tools.lisp (original) +++ trunk/src/xml/rdf/rdf_tools.lisp Tue Dec 1 07:50:56 2009 @@ -54,7 +54,8 @@ *tm2rdf-roletype-property* *tm2rdf-player-property* *tm2rdf-associationtype-property* - *rdf2tm-blank-node-prefix*) + *rdf2tm-blank-node-prefix* + *tm2rdf-association-reifier-property*) (:import-from :xml-constants *rdf_core_psis.xtm* *core_psis.xtm*) From lgiessmann at common-lisp.net Tue Dec 1 17:03:52 2009 From: lgiessmann at common-lisp.net (Lukas Giessmann) Date: Tue, 01 Dec 2009 12:03:52 -0500 Subject: [isidorus-cvs] r157 - trunk/src/xml/rdf Message-ID: Author: lgiessmann Date: Tue Dec 1 12:03:51 2009 New Revision: 157 Log: fixed a potential problem in the reification-support of the rdf-exporter that could occur if the reifier has more than one psi 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 Tue Dec 1 12:03:51 2009 @@ -360,8 +360,7 @@ 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 (when (psis construct) - (first (psis construct)))) + (let ((psi (get-reifier-psi construct)) (ii (item-identifiers construct)) (sl (locators construct)) (t-names (names construct)) @@ -562,7 +561,10 @@ When the topic does not own a psi the return value is nil." (declare (TopicC top)) (when (psis top) - (let ((full-uri (uri (first (psis top)))) + (let ((full-uri + (let ((reifier-psi (get-reifier-psi top))) + (when reifier-psi + (uri reifier-psi)))) (err "From get-reifier-uri(): ")) (let ((slash-position (find #\/ full-uri :from-end t))) (let ((hash-position (position #\# full-uri))) @@ -574,4 +576,20 @@ (subseq full-uri (+ 1 slash-position)) (if (= hash-position (+ (length full-uri) 1)) (error "~athe PSI-URI ~a ends with an #" err full-uri) - full-uri)))))))) \ No newline at end of file + full-uri)))))))) + + +(defun get-reifier-psi(topic) + "Returns the first found psi that can be used as a reifier-id, i.e. + the psi-uri must contain a '#' or '/'." + (declare (TopicC topic)) + (find-if #'(lambda(psi) + (let ((hash-position (position #\# (uri psi) :from-end t)) + (slash-position (position #\/ (uri psi) :from-end t))) + (if (or (and hash-position + (< hash-position (- (length (uri psi)) 1))) + (and slash-position + (< slash-position (- (length (uri psi)) 1)))) + psi + nil))) + (psis topic))) \ No newline at end of file From lgiessmann at common-lisp.net Fri Dec 4 13:13:26 2009 From: lgiessmann at common-lisp.net (Lukas Giessmann) Date: Fri, 04 Dec 2009 08:13:26 -0500 Subject: [isidorus-cvs] r158 - in trunk/src: . unit_tests xml/rdf Message-ID: Author: lgiessmann Date: Fri Dec 4 08:13:25 2009 New Revision: 158 Log: added a test file for the rdf-module with several reification-cases Added: trunk/src/unit_tests/reification.rdf Modified: trunk/src/isidorus.asd trunk/src/xml/rdf/exporter.lisp Modified: trunk/src/isidorus.asd ============================================================================== --- trunk/src/isidorus.asd (original) +++ trunk/src/isidorus.asd Fri Dec 4 08:13:25 2009 @@ -113,6 +113,7 @@ (:static-file "full_mapping.rdf") (:static-file "reification_xtm1.0.xtm") (:static-file "reification_xtm2.0.xtm") + (:static-file "reification.xtm") (:file "atom-conf") (:file "unittests-constants" :depends-on ("dangling_topicref.xtm" Added: trunk/src/unit_tests/reification.rdf ============================================================================== --- (empty file) +++ trunk/src/unit_tests/reification.rdf Fri Dec 4 08:13:25 2009 @@ -0,0 +1,98 @@ + + + + + + + + + Simpson + + + + + Simpson + + + Simpson + + + + + + + + + + + + + + + + + + Simpson + + + + + Lisa Simpson + + + + + + + + + Student + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + \ No newline at end of file Modified: trunk/src/xml/rdf/exporter.lisp ============================================================================== --- trunk/src/xml/rdf/exporter.lisp (original) +++ trunk/src/xml/rdf/exporter.lisp Fri Dec 4 08:13:25 2009 @@ -502,7 +502,7 @@ "Returns all associations that were mapped from RDF to TM and are still having two roles of the type isi:subject and isi:object." - (declare (TopicC subject-topic)) + (declare (Topic Csubject-topic)) (let ((isi-subject (get-item-by-psi *rdf2tm-subject*)) (isi-object (get-item-by-psi *rdf2tm-object*))) (let ((topic-roles From lgiessmann at common-lisp.net Fri Dec 4 13:15:56 2009 From: lgiessmann at common-lisp.net (Lukas Giessmann) Date: Fri, 04 Dec 2009 08:15:56 -0500 Subject: [isidorus-cvs] r159 - trunk/src/xml/rdf Message-ID: Author: lgiessmann Date: Fri Dec 4 08:15:56 2009 New Revision: 159 Log: fixed a mistake in the rdf-exporter 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 Fri Dec 4 08:15:56 2009 @@ -502,7 +502,7 @@ "Returns all associations that were mapped from RDF to TM and are still having two roles of the type isi:subject and isi:object." - (declare (Topic Csubject-topic)) + (declare (TopicC subject-topic)) (let ((isi-subject (get-item-by-psi *rdf2tm-subject*)) (isi-object (get-item-by-psi *rdf2tm-object*))) (let ((topic-roles From lgiessmann at common-lisp.net Fri Dec 4 15:10:37 2009 From: lgiessmann at common-lisp.net (Lukas Giessmann) Date: Fri, 04 Dec 2009 10:10:37 -0500 Subject: [isidorus-cvs] r160 - in trunk/src: . unit_tests xml/rdf Message-ID: Author: lgiessmann Date: Fri Dec 4 10:10:36 2009 New Revision: 160 Log: changed the rdf2tm-mapping when exporting reifiers; fixed some problems in the rdf-reification-test-file Modified: trunk/src/constants.lisp trunk/src/isidorus.asd trunk/src/unit_tests/reification.rdf trunk/src/unit_tests/reification_test.lisp trunk/src/unit_tests/unittests-constants.lisp trunk/src/xml/rdf/exporter.lisp trunk/src/xml/rdf/map_to_tm.lisp trunk/src/xml/rdf/rdf_tools.lisp Modified: trunk/src/constants.lisp ============================================================================== --- trunk/src/constants.lisp (original) +++ trunk/src/constants.lisp Fri Dec 4 10:10:36 2009 @@ -63,7 +63,7 @@ :*tm2rdf-associationtype-property* :*tm2rdf-player-property* :*rdf2tm-blank-node-prefix* - :*tm2rdf-association-reifier-property*)) + :*tm2rdf-reifier-property*)) (in-package :constants) @@ -173,4 +173,4 @@ (defparameter *tm2rdf-player-property* (concatenate 'string *tm2rdf-ns* "player")) -(defparameter *tm2rdf-association-reifier-property* (concatenate 'string *tm2rdf-ns* "association-reifier")) +(defparameter *tm2rdf-reifier-property* (concatenate 'string *tm2rdf-ns* "reifier")) Modified: trunk/src/isidorus.asd ============================================================================== --- trunk/src/isidorus.asd (original) +++ trunk/src/isidorus.asd Fri Dec 4 10:10:36 2009 @@ -113,7 +113,7 @@ (:static-file "full_mapping.rdf") (:static-file "reification_xtm1.0.xtm") (:static-file "reification_xtm2.0.xtm") - (:static-file "reification.xtm") + (:static-file "reification.rdf") (:file "atom-conf") (:file "unittests-constants" :depends-on ("dangling_topicref.xtm" Modified: trunk/src/unit_tests/reification.rdf ============================================================================== --- trunk/src/unit_tests/reification.rdf (original) +++ trunk/src/unit_tests/reification.rdf Fri Dec 4 10:10:36 2009 @@ -32,37 +32,40 @@ - + - + Simpson - + + Lisa Simpson + - + - - + + + Student - + - + - + @@ -70,26 +73,27 @@ - - - + + + - + + - + - + Modified: trunk/src/unit_tests/reification_test.lisp ============================================================================== --- trunk/src/unit_tests/reification_test.lisp (original) +++ trunk/src/unit_tests/reification_test.lisp Fri Dec 4 10:10:36 2009 @@ -37,7 +37,8 @@ :test-xtm2.0-reification :test-xtm1.0-reification-exporter :test-xtm2.0-reification-exporter - :test-rdf-importer-reification)) + :test-rdf-importer-reification + :test-rdf-importer-reification-2)) (in-package :reification-test) @@ -626,12 +627,27 @@ (elephant:close-store)) +(test test-rdf-importer-reification-2 + "Tests the rdf-importer, especially some reification cases of + the tm2rdf mapping." + (let ((db-dir "data_base") + (tm-id "http://test-tm/") + (revision-1 100) + (document-id "doc-id")) + (rdf-importer:rdf-importer + *reification.rdf* db-dir :tm-id tm-id + :document-id document-id :start-revision revision-1) + + )) + + ;;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 +;;TODO: DOKU (defun run-reification-tests () @@ -640,4 +656,5 @@ (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) - (it.bese.fiveam:run! 'test-rdf-importer-reification)) \ No newline at end of file + (it.bese.fiveam:run! 'test-rdf-importer-reification) + (it.bese.fiveam:run! 'test-rdf-importer-reification-2)) \ No newline at end of file Modified: trunk/src/unit_tests/unittests-constants.lisp ============================================================================== --- trunk/src/unit_tests/unittests-constants.lisp (original) +++ trunk/src/unit_tests/unittests-constants.lisp Fri Dec 4 10:10:36 2009 @@ -33,7 +33,8 @@ :*poems_light.xtm* :*full_mapping.rdf* :*reification_xtm1.0.xtm* - :*reification_xtm2.0.xtm*)) + :*reification_xtm2.0.xtm* + :*reification.rdf*)) (in-package :unittests-constants) @@ -113,4 +114,8 @@ (defparameter *reification_xtm2.0.xtm* (asdf:component-pathname - (asdf:find-component *unit-tests-component* "reification_xtm2.0.xtm"))) \ No newline at end of file + (asdf:find-component *unit-tests-component* "reification_xtm2.0.xtm"))) + +(defparameter *reification.rdf* + (asdf:component-pathname + (asdf:find-component *unit-tests-component* "reification.rdf"))) Modified: trunk/src/xml/rdf/exporter.lisp ============================================================================== --- trunk/src/xml/rdf/exporter.lisp (original) +++ trunk/src/xml/rdf/exporter.lisp Fri Dec 4 10:10:36 2009 @@ -27,7 +27,7 @@ *tm2rdf-topic-type-uri* *tm2rdf-association-type-uri* *tm2rdf-role-type-uri* - *tm2rdf-association-reifier-property*) + *tm2rdf-reifier-property*) (:import-from :isidorus-threading with-reader-lock with-writer-lock) @@ -213,7 +213,11 @@ or rdf:nodeID, this depends on the PSIS of the topic." (declare (TopicC topic)) (if (psis topic) - (cxml:attribute "rdf:resource" (uri (first (psis topic)))) + (cxml:attribute "rdf:resource" + (let ((psi (get-reifier-psi topic))) + (if psi + (concatenate 'string "#" (get-reifier-uri topic)) + (uri (first (psis topic)))))) (cxml:attribute "rdf:nodeID" (make-object-id topic)))) @@ -280,13 +284,10 @@ "Creates a blank node that represents a VariantC element with the properties itemIdentity, scope and value." (cxml:with-element "isi:variant" - (when (reifier construct) - (let ((reifier-uri (get-reifier-uri (reifier construct)))) - (when reifier-uri - (cxml:attribute "rdf:ID" reifier-uri)))) (cxml:with-element "rdf:Description" (cxml:attribute "rdf:nodeID" (make-object-id construct)) (make-isi-type *tm2rdf-variant-type-uri*) + (export-reifier-as-mapping construct) (map 'list #'to-rdf-elem (item-identifiers construct)) (scopes-to-rdf-elems construct) (resourceX-to-rdf-elem construct)))) @@ -296,13 +297,10 @@ "Creates a blank node that represents a name element with the properties itemIdentity, nametype, value, variant and scope." (cxml:with-element "isi:name" - (when (reifier construct) - (let ((reifier-uri (get-reifier-uri (reifier construct)))) - (when reifier-uri - (cxml:attribute "rdf:ID" reifier-uri)))) (cxml:with-element "rdf:Description" (cxml:attribute "rdf:nodeID" (make-object-id construct)) (make-isi-type *tm2rdf-name-type-uri*) + (export-reifier-as-mapping construct) (map 'list #'to-rdf-elem (item-identifiers construct)) (when (slot-boundp construct 'instance-of) (cxml:with-element "isi:nametype" @@ -326,13 +324,10 @@ (item-identifiers construct) (/= (length (psis (instance-of construct))) 1)) (cxml:with-element "isi:occurrence" - (when (reifier construct) - (let ((reifier-uri (get-reifier-uri (reifier construct)))) - (when reifier-uri - (cxml:attribute "rdf:ID" reifier-uri)))) (cxml:with-element "rdf:Description" (cxml:attribute "rdf:nodeID" (make-object-id construct)) (make-isi-type *tm2rdf-occurrence-type-uri*) + (export-reifier-as-mapping construct) (map 'list #'to-rdf-elem (item-identifiers construct)) (cxml:with-element "isi:occurrencetype" (make-topic-reference (instance-of construct))) @@ -340,6 +335,7 @@ (resourceX-to-rdf-elem construct))) (with-property construct (cxml:attribute "rdf:datatype" (datatype construct)) + (export-reifier construct) (when (themes construct) (cxml:attribute "xml:lang" (get-xml-lang (first (themes construct))))) @@ -442,9 +438,7 @@ (cxml:with-element "rdf:Description" (cxml:attribute "rdf:nodeID" (make-object-id association)) (make-isi-type *tm2rdf-association-type-uri*) - (when (reifier association) - (cxml:with-element *tm2rdf-association-reifier-property* - (make-topic-reference (reifier association)))) + (export-reifier-as-mapping association) (cxml:with-element "isi:associationtype" (make-topic-reference association-type)) (map 'list #'to-rdf-elem ii) @@ -461,9 +455,7 @@ (cxml:with-element "isi:role" (cxml:with-element "rdf:Description" (cxml:attribute "rdf:nodeID" (make-object-id construct)) - (when (reifier construct) - (cxml:with-element *tm2rdf-association-reifier-property* - (make-topic-reference (reifier construct)))) + (export-reifier-as-mapping construct) (make-isi-type *tm2rdf-role-type-uri*) (map 'list #'to-rdf-elem ii) (cxml:with-element "isi:roletype" @@ -491,10 +483,7 @@ (when (and subject-role object-role (= (length association-roles) 2)) (with-property association - (when (reifier association) - (let ((reifier-uri (get-reifier-uri (reifier association)))) - (when reifier-uri - (cxml:attribute "rdf:ID" reifier-uri)))) + (export-reifier association) (make-topic-reference (player object-role))))))) @@ -556,6 +545,18 @@ (cxml:attribute "rdf:ID" reifier-uri)))))) +(defun export-reifier-as-mapping (reifiable-construct) + "Exports the reifier as isi:reifier property." + (declare (ReifiableConstructC reifiable-construct)) + (let ((reifier-topic (reifier reifiable-construct))) + (when (and reifier-topic + (psis reifier-topic)) + (let ((reifier-uri (get-reifier-uri reifier-topic))) + (when reifier-uri + (cxml:with-element *tm2rdf-reifier-property* + (cxml:attribute "rdf:resource" reifier-uri))))))) + + (defun get-reifier-uri (top) "Returns the uri that represents the reifier-id of a resource node. When the topic does not own a psi the return value is nil." Modified: trunk/src/xml/rdf/map_to_tm.lisp ============================================================================== --- trunk/src/xml/rdf/map_to_tm.lisp (original) +++ trunk/src/xml/rdf/map_to_tm.lisp Fri Dec 4 10:10:36 2009 @@ -105,14 +105,14 @@ (get-associations-by-type assoc-top start-revision *tm2rdf-role-property* *rdf2tm-subject*))) - (let ((players-and-reifiers - (get-players-and-reifiers-by-role-type + (let ((players + (get-players-by-role-type role-assocs start-revision *rdf2tm-object*))) (map 'list #'d::delete-construct role-assocs) - players-and-reifiers))) + players))) -(defun map-isi-role(role-top reifier-topic start-revision) +(defun map-isi-role(role-top start-revision) "Maps a passed topic with all its isidorus:types to a property list representing an association-role." (declare (TopicC role-top)) @@ -130,7 +130,8 @@ (let ((types (get-players-by-role-type type-assocs start-revision *rdf2tm-object*)) (role-players (get-players-by-role-type - player-assocs start-revision *rdf2tm-object*))) + player-assocs start-revision *rdf2tm-object*)) + (reifiers (get-isi-reifiers role-top start-revision))) (elephant:ensure-transaction (:txn-nosync t) (map 'list #'d::delete-construct type-assocs) (map 'list #'d::delete-construct player-assocs) @@ -145,7 +146,7 @@ (list :instance-of (first types) :player (first role-players) :item-identifiers ids - :reifier reifier-topic))))) + :reifiers reifiers))))) (defun map-isi-association(assoc-top start-revision tm-id @@ -160,28 +161,21 @@ (get-associations-by-type assoc-top start-revision *tm2rdf-associationtype-property* *rdf2tm-subject*)) - (reifier-assocs - (get-associations-by-type - assoc-top start-revision *tm2rdf-association-reifier-property* - *rdf2tm-subject*)) (scope-assocs (get-associations-by-type assoc-top start-revision *tm2rdf-scope-property* *rdf2tm-subject*)) - (role-and-reifier-topics (get-isi-roles assoc-top start-revision))) + (role-topics (get-isi-roles assoc-top start-revision))) (let ((types (get-players-by-role-type type-assocs start-revision *rdf2tm-object*)) (scopes (get-players-by-role-type scope-assocs start-revision *rdf2tm-object*)) - (reifier-topics (get-players-by-role-type - reifier-assocs start-revision *rdf2tm-object*)) + (reifier-topics (get-isi-reifiers assoc-top start-revision)) (assoc-roles (remove-if #'null (map 'list - #'(lambda(role-and-reifier) - (map-isi-role (getf role-and-reifier :player) - (getf role-and-reifier :reifier) - start-revision)) - role-and-reifier-topics)))) + #'(lambda(role-topic) + (map-isi-role role-topic start-revision)) + role-topics)))) (elephant:ensure-transaction (:txn-nosync t) (map 'list #'d::delete-construct type-assocs) (map 'list #'d::delete-construct scope-assocs) @@ -210,13 +204,14 @@ (getf list-item :instance-of)) (eql (player association-role) (getf list-item :player)) - (getf list-item :reifier))) + (getf list-item :reifiers))) assoc-roles))) (when found-item - (add-reifier association-role (getf found-item :reifier))))) + (dolist (reifier-topic (getf found-item :reifiers)) + (add-reifier association-role reifier-topic))))) (roles association)) - (when reifier-topics - (add-reifier association (first reifier-topics))) + (dolist (reifier-topic reifier-topics) + (add-reifier association reifier-topic)) association))))))) @@ -232,21 +227,17 @@ top start-revision :id-type-uri *tm2rdf-subjectlocator-property*)) (new-item-ids (map-isi-identifiers top start-revision)) - (occurrence-and-reifier-topics (get-isi-occurrences top start-revision)) - (name-and-reifier-topics (get-isi-names top start-revision))) + (occurrence-topics (get-isi-occurrences top start-revision)) + (name-topics (get-isi-names top start-revision))) (bound-subject-identifiers top new-psis) (bound-subject-locators top new-locators) (bound-item-identifiers top new-item-ids) - (map 'list #'(lambda(occurrence-and-reifier) - (map-isi-occurrence top (getf occurrence-and-reifier :player) - (getf occurrence-and-reifier :reifier) - start-revision)) - occurrence-and-reifier-topics) - (map 'list #'(lambda(name-and-reifier) - (map-isi-name top (getf name-and-reifier :player) - (getf name-and-reifier :reifier) - start-revision)) - name-and-reifier-topics)) + (map 'list #'(lambda(occurrence-topic) + (map-isi-occurrence top occurrence-topic start-revision)) + occurrence-topics) + (map 'list #'(lambda(name-topic) + (map-isi-name top name-topic start-revision)) + name-topics)) top) @@ -258,14 +249,14 @@ (get-associations-by-type name-top start-revision *tm2rdf-variant-property* *rdf2tm-subject*))) - (let ((players-and-reifiers - (get-players-and-reifiers-by-role-type + (let ((players + (get-players-by-role-type variant-assocs start-revision *rdf2tm-object*))) (map 'list #'d::delete-construct variant-assocs) - players-and-reifiers))) + players))) -(defun map-isi-variant (name variant-top reifier-topic start-revision) +(defun map-isi-variant (name variant-top start-revision) "Maps the passed variant-topic to a TM variant." (declare (TopicC variant-top)) (declare (NameC name)) @@ -288,7 +279,8 @@ (list :value (charvalue value-occ) :datatype (datatype value-occ)) (list :value "" - :datatype *xml-string*))))) + :datatype *xml-string*)))) + (reifiers (get-isi-reifiers variant-top start-revision))) (elephant:ensure-transaction (:txn-nosync t) (map 'list #'d::delete-construct scope-assocs) (delete-related-associations variant-top) @@ -301,11 +293,12 @@ :charvalue (getf value-and-datatype :value) :datatype (getf value-and-datatype :datatype) :name name))) - (add-reifier variant reifier-topic) + (dolist (reifier-topic reifiers) + (add-reifier variant reifier-topic)) variant))))) -(defun map-isi-name (top name-top reifier-topic start-revision) +(defun map-isi-name (top name-top start-revision) "Maps the passed occurrence-topic to a TM occurrence." (declare (TopicC top name-top)) (declare (integer start-revision)) @@ -320,7 +313,7 @@ *rdf2tm-subject*)) (value-type-topic (get-item-by-psi *tm2rdf-value-property*)) - (variant-and-reifier-topics (get-isi-variants name-top start-revision))) + (variant-topics (get-isi-variants name-top start-revision))) (let ((type (let ((fn-types (get-players-by-role-type type-assocs start-revision *rdf2tm-object*))) @@ -335,7 +328,8 @@ (occurrences name-top)))) (if value-occ (charvalue value-occ) - "")))) + ""))) + (reifiers (get-isi-reifiers name-top start-revision))) (elephant:ensure-transaction (:txn-nosync t) (map 'list #'d::delete-construct type-assocs) (map 'list #'d::delete-construct scope-assocs) @@ -346,14 +340,14 @@ :instance-of type :item-identifiers ids :themes scopes))) - (add-reifier name reifier-topic) - (map 'list #'(lambda(variant-and-reifier) - (map-isi-variant name (getf variant-and-reifier :player) - (getf variant-and-reifier :reifier) + (map 'list #'(lambda(variant-topic) + (map-isi-variant name variant-topic start-revision)) - variant-and-reifier-topics) + variant-topics) (delete-related-associations name-top) (d::delete-construct name-top) + (dolist (reifier-topic reifiers) + (add-reifier name reifier-topic)) name))))) @@ -364,14 +358,14 @@ (let ((assocs (get-associations-by-type top start-revision *tm2rdf-name-property* *rdf2tm-subject*))) - (let ((name-and-reifier-topics - (get-players-and-reifiers-by-role-type + (let ((name-topics + (get-players-by-role-type assocs start-revision *rdf2tm-object*))) (map 'list #'d::delete-construct assocs) - name-and-reifier-topics))) + name-topics))) -(defun map-isi-occurrence(top occ-top reifier-topic start-revision) +(defun map-isi-occurrence(top occ-top start-revision) "Maps all topics that represents occurrences of the passed topic top to occurrence objects." (declare (TopicC top occ-top)) @@ -401,7 +395,8 @@ (list :value (charvalue value-occ) :datatype (datatype value-occ)) (list :value "" - :datatype *xml-string*))))) + :datatype *xml-string*)))) + (reifiers (get-isi-reifiers occ-top start-revision))) (elephant:ensure-transaction (:txn-nosync t) (map 'list #'d::delete-construct type-assocs) (map 'list #'d::delete-construct scope-assocs) @@ -419,7 +414,8 @@ :instance-of (first types) :charvalue (getf value-and-datatype :value) :datatype (getf value-and-datatype :datatype)))) - (add-reifier occurrence reifier-topic) + (dolist (reifier-topic reifiers) + (add-reifier occurrence reifier-topic)) occurrence))))) @@ -430,11 +426,11 @@ (let ((assocs (get-associations-by-type top start-revision *tm2rdf-occurrence-property* *rdf2tm-subject*))) - (let ((occurrences-and-reifiers - (get-players-and-reifiers-by-role-type + (let ((occurrence-topics + (get-players-by-role-type assocs start-revision *rdf2tm-object*))) (map 'list #'d::delete-construct assocs) - occurrences-and-reifiers))) + occurrence-topics))) (defun get-isi-topics (tm-id start-revision @@ -510,31 +506,6 @@ players))) -(defun get-players-and-reifiers-by-role-type (associations start-revision - role-type-psi) - "Returns tuples of the form (:player :reifier )" - (declare (list associations)) - (declare (integer start-revision)) - (declare (string role-type-psi)) - (let ((role-type (get-item-by-psi role-type-psi - :revision start-revision))) - (let ((tuples - (remove-if - #'null - (map 'list - #'(lambda(assoc) - (let ((role - (find-if #'(lambda(role) - (eql role-type (instance-of role))) - (roles assoc)))) - (when role - (let ((reifier-topic (reifier assoc))) - (list :player (player role) - :reifier reifier-topic))))) - associations)))) - tuples))) - - (defun get-occurrences-by-type (top start-revision &key (occurrence-type-uri *tm2rdf-itemIdentity-property*)) @@ -626,3 +597,16 @@ (d::delete-construct id) (setf (identified-construct id) top))) top) + + +(defun get-isi-reifiers (construct start-revision) + "Returns all reifiers from the passed construct." + (declare (TopicC construct)) + (let ((reifier-assocs + (get-associations-by-type + construct start-revision *tm2rdf-reifier-property* + *rdf2tm-subject*))) + (let ((reifiers + (get-players-by-role-type + reifier-assocs start-revision *rdf2tm-object*))) + reifiers))) \ No newline at end of file Modified: trunk/src/xml/rdf/rdf_tools.lisp ============================================================================== --- trunk/src/xml/rdf/rdf_tools.lisp (original) +++ trunk/src/xml/rdf/rdf_tools.lisp Fri Dec 4 10:10:36 2009 @@ -55,7 +55,7 @@ *tm2rdf-player-property* *tm2rdf-associationtype-property* *rdf2tm-blank-node-prefix* - *tm2rdf-association-reifier-property*) + *tm2rdf-reifier-property*) (:import-from :xml-constants *rdf_core_psis.xtm* *core_psis.xtm*) From lgiessmann at common-lisp.net Fri Dec 4 16:06:22 2009 From: lgiessmann at common-lisp.net (Lukas Giessmann) Date: Fri, 04 Dec 2009 11:06:22 -0500 Subject: [isidorus-cvs] r161 - in trunk/src: unit_tests xml/rdf Message-ID: Author: lgiessmann Date: Fri Dec 4 11:06:21 2009 New Revision: 161 Log: added some unit-tests for the rdf-module Modified: trunk/src/unit_tests/reification.rdf trunk/src/unit_tests/reification_test.lisp trunk/src/xml/rdf/map_to_tm.lisp Modified: trunk/src/unit_tests/reification.rdf ============================================================================== --- trunk/src/unit_tests/reification.rdf (original) +++ trunk/src/unit_tests/reification.rdf Fri Dec 4 11:06:21 2009 @@ -32,6 +32,7 @@ + Modified: trunk/src/unit_tests/reification_test.lisp ============================================================================== --- trunk/src/unit_tests/reification_test.lisp (original) +++ trunk/src/unit_tests/reification_test.lisp Fri Dec 4 11:06:21 2009 @@ -38,7 +38,8 @@ :test-xtm1.0-reification-exporter :test-xtm2.0-reification-exporter :test-rdf-importer-reification - :test-rdf-importer-reification-2)) + :test-rdf-importer-reification-2 + :test-rdf-importer-reification-3)) (in-package :reification-test) @@ -550,6 +551,7 @@ "" "" ""))) + (clean-out-db db-dir) (let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder)))) (is-true dom-1) (is (= (length (dom:child-nodes dom-1)) 1)) @@ -634,11 +636,67 @@ (tm-id "http://test-tm/") (revision-1 100) (document-id "doc-id")) + (clean-out-db db-dir) (rdf-importer:rdf-importer *reification.rdf* db-dir :tm-id tm-id :document-id document-id :start-revision revision-1) + (elephant:open-store (xml-importer:get-store-spec db-dir)) + (let ((homer (get-item-by-id "http://simpsons.tv/homer" :xtm-id document-id)) + (bart (get-item-by-id "http://simpsons.tv/bart" :xtm-id document-id)) + (married (get-item-by-id "http://simpsons.tv/arcs/married" :xtm-id document-id))) + (is-true homer) + (is-true bart) + (is-true married) + (is (= (length (used-as-type married)) 1)) + (is-true (reifier (first (used-as-type married)))) + (is-true (reified (reifier (first (used-as-type married))))) + (is (= (length (psis (reifier (first (used-as-type married))))) 1)) + (is (string= (uri (first (psis (reifier (first (used-as-type married)))))) + "http://test-tm#married-arc")) + (is (= (length (occurrences bart)) 1)) + (is-true (reifier (first (occurrences bart)))) + (is-true (reified (reifier (first (occurrences bart))))) + (is (string= (uri (first (psis (reifier (first (occurrences bart)))))) + "http://test-tm#lastName-arc")))) + (elephant:close-store)) - )) + +(test test-rdf-importer-reification-3 + "Tests the rdf-importer, especially some reification cases of + the tm2rdf mapping." + (let ((db-dir "data_base") + (tm-id "http://test-tm/") + (revision-1 100) + (document-id "doc-id")) + (clean-out-db db-dir) + (rdf-importer:rdf-importer + *reification.rdf* db-dir :tm-id tm-id + :document-id document-id :start-revision revision-1) + (elephant:open-store (xml-importer:get-store-spec db-dir)) + (let ((lisa (get-item-by-id "http://simpsons.tv/lisa" :xtm-id document-id))) + (is-true lisa) + (is (= (length (names lisa)) 1)) + (is (= (length (occurrences lisa)) 1)) + (let ((name (first (names lisa))) + (occurrence (first (occurrences lisa)))) + (is (= (length (variants name)) 1)) + (let ((variant (first (variants name)))) + (is-true (reifier name)) + (is-true (reified (reifier name))) + (is (= (length (psis (reifier name))) 1)) + (is (string= (uri (first (psis (reifier name)))) + (concatenate 'string tm-id "lisa-name"))) + (is-true (reifier variant)) + (is-true (reified (reifier variant))) + (is (= (length (psis (reifier variant))) 1)) + (is (string= (uri (first (psis (reifier variant)))) + (concatenate 'string tm-id "lisa-name-variant"))) + (is-true (reifier occurrence)) + (is-true (reified (reifier occurrence))) + (is (= (length (psis (reifier occurrence))) 1)) + (is (string= (uri (first (psis (reifier occurrence)))) + (concatenate 'string tm-id "lisa-occurrence"))))))) + (elephant:close-store)) @@ -647,6 +705,7 @@ ;;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 @@ -657,4 +716,5 @@ (it.bese.fiveam:run! 'test-xtm1.0-reification-exporter) (it.bese.fiveam:run! 'test-xtm2.0-reification-exporter) (it.bese.fiveam:run! 'test-rdf-importer-reification) - (it.bese.fiveam:run! 'test-rdf-importer-reification-2)) \ No newline at end of file + (it.bese.fiveam:run! 'test-rdf-importer-reification-2) + (it.bese.fiveam:run! 'test-rdf-importer-reification-3)) \ No newline at end of file Modified: trunk/src/xml/rdf/map_to_tm.lisp ============================================================================== --- trunk/src/xml/rdf/map_to_tm.lisp (original) +++ trunk/src/xml/rdf/map_to_tm.lisp Fri Dec 4 11:06:21 2009 @@ -45,7 +45,7 @@ *tm2rdf-occurrence-property* *tm2rdf-roletype-property* *tm2rdf-variant-property* *tm2rdf-occurrencetype-property* *tm2rdf-name-property* *tm2rdf-associationtype-property* - *tm2rdf-scope-property*))) + *tm2rdf-scope-property* *tm2rdf-reifier-property*))) (dolist (uri psi-uris) (delete-topic-if-not-referenced uri start-revision)))) From lgiessmann at common-lisp.net Fri Dec 4 19:56:13 2009 From: lgiessmann at common-lisp.net (Lukas Giessmann) Date: Fri, 04 Dec 2009 14:56:13 -0500 Subject: [isidorus-cvs] r162 - trunk/src/unit_tests Message-ID: Author: lgiessmann Date: Fri Dec 4 14:56:13 2009 New Revision: 162 Log: finalized the rdf-importer-reification unit-tests Modified: trunk/src/unit_tests/reification.rdf trunk/src/unit_tests/reification_test.lisp Modified: trunk/src/unit_tests/reification.rdf ============================================================================== --- trunk/src/unit_tests/reification.rdf (original) +++ trunk/src/unit_tests/reification.rdf Fri Dec 4 14:56:13 2009 @@ -80,15 +80,15 @@ - - + - + + Modified: trunk/src/unit_tests/reification_test.lisp ============================================================================== --- trunk/src/unit_tests/reification_test.lisp (original) +++ trunk/src/unit_tests/reification_test.lisp Fri Dec 4 14:56:13 2009 @@ -39,7 +39,8 @@ :test-xtm2.0-reification-exporter :test-rdf-importer-reification :test-rdf-importer-reification-2 - :test-rdf-importer-reification-3)) + :test-rdf-importer-reification-3 + :test-rdf-importer-reification-4)) (in-package :reification-test) @@ -699,9 +700,46 @@ (elephant:close-store)) +(test test-rdf-importer-reification-4 + "Tests the rdf-importer, especially some reification cases of + the tm2rdf mapping." + (let ((db-dir "data_base") + (tm-id "http://test-tm/") + (revision-1 100) + (document-id "doc-id")) + (clean-out-db db-dir) + (rdf-importer:rdf-importer + *reification.rdf* db-dir :tm-id tm-id + :document-id document-id :start-revision revision-1) + (elephant:open-store (xml-importer:get-store-spec db-dir)) + (let ((friendship (get-item-by-id "http://simpsons.tv/friendship" :xtm-id document-id)) + (carl (get-item-by-id "http://simpsons.tv/carl" :xtm-id document-id))) + (is-true friendship) + (is-true carl) + (is (= (length (used-as-type friendship)) 1)) + (is (typep (first (used-as-type friendship)) 'd:AssociationC)) + (let ((friendship-association (first (used-as-type friendship)))) + (is-true (reifier friendship-association)) + (is-true (reified (reifier friendship-association))) + (is (= (length (psis (reifier friendship-association))) 1)) + (is (string= (uri (first (psis (reifier friendship-association)))) + (concatenate 'string tm-id "friendship-association"))) + (is (= (length (roles friendship-association)) 2)) + (let ((carl-role + (find-if #'(lambda(role) + (eql (player role) carl)) + (roles friendship-association)))) + (is-true carl-role) + (is-true (reifier carl-role)) + (is-true (reified (reifier carl-role))) + (is (= (length (psis (reifier carl-role))) 1)) + (is (string= (uri (first (psis (reifier carl-role)))) + (concatenate 'string tm-id "friend-role"))))))) + (elephant:close-store)) + + ;;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 @@ -717,4 +755,5 @@ (it.bese.fiveam:run! 'test-xtm2.0-reification-exporter) (it.bese.fiveam:run! 'test-rdf-importer-reification) (it.bese.fiveam:run! 'test-rdf-importer-reification-2) - (it.bese.fiveam:run! 'test-rdf-importer-reification-3)) \ No newline at end of file + (it.bese.fiveam:run! 'test-rdf-importer-reification-3) + (it.bese.fiveam:run! 'test-rdf-importer-reification-4)) \ No newline at end of file From lgiessmann at common-lisp.net Sun Dec 6 19:45:24 2009 From: lgiessmann at common-lisp.net (Lukas Giessmann) Date: Sun, 06 Dec 2009 14:45:24 -0500 Subject: [isidorus-cvs] r163 - in trunk/src: unit_tests xml/rdf Message-ID: Author: lgiessmann Date: Sun Dec 6 14:45:23 2009 New Revision: 163 Log: fixed some addressing-problems by exporting reifier-topics Modified: trunk/src/unit_tests/reification_test.lisp trunk/src/xml/rdf/exporter.lisp Modified: trunk/src/unit_tests/reification_test.lisp ============================================================================== --- trunk/src/unit_tests/reification_test.lisp (original) +++ trunk/src/unit_tests/reification_test.lisp Sun Dec 6 14:45:23 2009 @@ -40,7 +40,8 @@ :test-rdf-importer-reification :test-rdf-importer-reification-2 :test-rdf-importer-reification-3 - :test-rdf-importer-reification-4)) + :test-rdf-importer-reification-4 + :test-rdf-reification-exporter)) (in-package :reification-test) @@ -521,6 +522,8 @@ when (string= (dom:get-attribute ii "href") "http://simpsons.tv/married-husband-role") return t) return t))))) + (handler-case (delete-file output-file) + (error () )) ;do nothing (elephant:close-store))) @@ -738,6 +741,27 @@ (elephant:close-store)) +(test test-rdf-reification-exporter + "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 + (rdf-importer:rdf-importer *reification.rdf* + :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:close-store)) + + ;;TODO: check rdf exporter ;;TODO: check merge-reifier-topics (--> versioning) @@ -756,4 +780,5 @@ (it.bese.fiveam:run! 'test-rdf-importer-reification) (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)) \ No newline at end of file + (it.bese.fiveam:run! 'test-rdf-importer-reification-4) + (it.bese.fiveam:run! 'test-rdf-reification-exporter)) \ No newline at end of file Modified: trunk/src/xml/rdf/exporter.lisp ============================================================================== --- trunk/src/xml/rdf/exporter.lisp (original) +++ trunk/src/xml/rdf/exporter.lisp Sun Dec 6 14:45:23 2009 @@ -214,10 +214,12 @@ (declare (TopicC topic)) (if (psis topic) (cxml:attribute "rdf:resource" - (let ((psi (get-reifier-psi topic))) - (if psi - (concatenate 'string "#" (get-reifier-uri topic)) - (uri (first (psis topic)))))) + (if (reified topic) + (let ((psi (get-reifier-psi topic))) + (if psi + (concatenate 'string "#" (get-reifier-uri topic)) + (uri (first (psis topic))))) + (uri (first (psis topic))))) (cxml:attribute "rdf:nodeID" (make-object-id topic)))) @@ -351,8 +353,7 @@ (occurrences construct))) (or (used-as-type construct) (used-as-theme construct) - (xml-lang-p construct) - (reified construct))) + (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" @@ -366,7 +367,7 @@ (if (reified construct) (let ((reifier-uri (get-reifier-uri construct))) (if reifier-uri - (concatenate 'string "#" (get-reifier-uri construct)) + (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))) @@ -553,7 +554,7 @@ (psis reifier-topic)) (let ((reifier-uri (get-reifier-uri reifier-topic))) (when reifier-uri - (cxml:with-element *tm2rdf-reifier-property* + (cxml:with-element "isi:reifier" (cxml:attribute "rdf:resource" reifier-uri))))))) @@ -567,11 +568,11 @@ (when reifier-psi (uri reifier-psi)))) (err "From get-reifier-uri(): ")) - (let ((slash-position (find #\/ full-uri :from-end t))) + (let ((slash-position (position #\/ full-uri :from-end t))) (let ((hash-position (position #\# full-uri))) (if (and hash-position (/= (- (length full-uri) 1) hash-position)) - (subseq full-uri (- hash-position 1)) + (subseq full-uri (+ hash-position 1)) (if (and slash-position (/= (- (length full-uri) 1) slash-position)) (subseq full-uri (+ 1 slash-position)) From lgiessmann at common-lisp.net Mon Dec 7 14:08:02 2009 From: lgiessmann at common-lisp.net (Lukas Giessmann) Date: Mon, 07 Dec 2009 09:08:02 -0500 Subject: [isidorus-cvs] r164 - in trunk/src: model unit_tests Message-ID: 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 From lgiessmann at common-lisp.net Mon Dec 7 16:09:02 2009 From: lgiessmann at common-lisp.net (Lukas Giessmann) Date: Mon, 07 Dec 2009 11:09:02 -0500 Subject: [isidorus-cvs] r165 - trunk/src/unit_tests Message-ID: 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 From lgiessmann at common-lisp.net Tue Dec 8 15:46:53 2009 From: lgiessmann at common-lisp.net (Lukas Giessmann) Date: Tue, 08 Dec 2009 10:46:53 -0500 Subject: [isidorus-cvs] r166 - in trunk/src: model unit_tests Message-ID: 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 From lgiessmann at common-lisp.net Thu Dec 10 13:01:01 2009 From: lgiessmann at common-lisp.net (Lukas Giessmann) Date: Thu, 10 Dec 2009 08:01:01 -0500 Subject: [isidorus-cvs] r167 - in trunk/src: rest_interface unit_tests xml/rdf Message-ID: 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/ +(defparameter *json-get-prefix* "/json/get/(.+)$") ;the prefix to get a fragment by the psi -> localhost:8000/json/get/ +(defparameter *json-get-rdf-prefix* "/json/get/rdf/(.+)$") ;the prefix to get a fragment by the psi -> localhost:8000/json/rdf/get/ (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)) + + From lgiessmann at common-lisp.net Thu Dec 10 14:44:48 2009 From: lgiessmann at common-lisp.net (Lukas Giessmann) Date: Thu, 10 Dec 2009 09:44:48 -0500 Subject: [isidorus-cvs] r168 - trunk/src/xml/rdf Message-ID: 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")) From lgiessmann at common-lisp.net Thu Dec 10 14:53:34 2009 From: lgiessmann at common-lisp.net (Lukas Giessmann) Date: Thu, 10 Dec 2009 09:53:34 -0500 Subject: [isidorus-cvs] r169 - trunk/src/model Message-ID: 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") From lgiessmann at common-lisp.net Thu Dec 10 18:23:13 2009 From: lgiessmann at common-lisp.net (Lukas Giessmann) Date: Thu, 10 Dec 2009 13:23:13 -0500 Subject: [isidorus-cvs] r170 - in trunk/src: model unit_tests xml/xtm Message-ID: 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 @@ - - + + - superclass-subclass + supertype-subtype - - + + - superclass + supertype - - + + - subclass + subtype From lgiessmann at common-lisp.net Fri Dec 11 23:37:41 2009 From: lgiessmann at common-lisp.net (Lukas Giessmann) Date: Fri, 11 Dec 2009 18:37:41 -0500 Subject: [isidorus-cvs] r171 - trunk/src/unit_tests Message-ID: 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))))))))) From lgiessmann at common-lisp.net Sat Dec 12 00:29:02 2009 From: lgiessmann at common-lisp.net (Lukas Giessmann) Date: Fri, 11 Dec 2009 19:29:02 -0500 Subject: [isidorus-cvs] r172 - in trunk/src: model xml/rdf xml/xtm Message-ID: 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 From lgiessmann at common-lisp.net Tue Dec 22 17:43:33 2009 From: lgiessmann at common-lisp.net (Lukas Giessmann) Date: Tue, 22 Dec 2009 12:43:33 -0500 Subject: [isidorus-cvs] r173 - in trunk/src: model xml/xtm Message-ID: 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