Author: lgiessmann Date: Mon Aug 10 06:48:58 2009 New Revision: 112 Log: rdf-importer: fixed a problem with rdf:li, so distributed rdf:li elementes ar not merged. intead of merging names the names of the form rdf:_n are incremented across the entire document for the same resource. when the user mixes rdf:li elements and rdf:_n elements on one resource there is no separate handling, i.e.these elements are merged anyway. Modified: trunk/src/unit_tests/rdf_importer_test.lisp trunk/src/xml/rdf/importer.lisp trunk/src/xml/rdf/rdf_tools.lisp Modified: trunk/src/unit_tests/rdf_importer_test.lisp ============================================================================== --- trunk/src/unit_tests/rdf_importer_test.lisp (original) +++ trunk/src/unit_tests/rdf_importer_test.lisp Mon Aug 10 06:48:58 2009 @@ -880,16 +880,18 @@ (is (= (length (dom:child-nodes dom-1)))) (let ((node (elt (dom:child-nodes dom-1) 0))) (is-true (rdf-importer::parse-node node)) - (is-true (rdf-importer::parse-properties-of-node node)) - (is (= (length rdf-importer::*_n-map*) 8)) + (is-true (rdf-importer::parse-properties-of-node + node "http://xml-base/first/resource")) + (is (= (length rdf-importer::*_n-map*) 1)) + (is (= (length (getf (first rdf-importer::*_n-map*) :props)) 8)) (dotimes (iter (length rdf-importer::*_n-map*)) (is-true (find-if #'(lambda(x) - (string= (getf x :type) + (string= (getf x :name) (concatenate 'string *rdf-ns* "_" (write-to-string (+ 1 iter))))) - rdf-importer::*_n-map*))) + (getf (first rdf-importer::*_n-map*) :props)))) (let ((assocs (rdf-importer::get-associations-of-node-content node tm-id nil)) (content-literals @@ -985,8 +987,7 @@ (getf x :ID) "http://xml-base/first#rdfID-4"))) content-literals))) - (rdf-importer::remove-node-properties-from-*_n-map* node) - (is (= (length rdf-importer::*_n-map*) 0)))))) + (setf rdf-importer::*_n-map* nil))))) (test test-import-node-1 @@ -1741,7 +1742,7 @@ (date "http://www.w3.org/2001/XMLSchema#date") (de (d:get-item-by-id "http://isidorus/rdf2tm_mapping/scope#de")) (long "http://www.w3.org/2001/XMLSchema#unsignedLong")) - (is (= (length topics) 65)) + (is (= (length topics) 66)) (is (= (length occs) 23)) (is (= (length assocs) 30)) (is-true de) @@ -2285,7 +2286,7 @@ #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) - (concatenate 'string constants:*rdf-ns* "_1")) + (concatenate 'string constants:*rdf-ns* "_2")) (find-if #'(lambda(y) (and (eql (d:instance-of y) isi-subject) @@ -2304,7 +2305,7 @@ #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) - (concatenate 'string constants:*rdf-ns* "_2")) + (concatenate 'string constants:*rdf-ns* "_3")) (find-if #'(lambda(y) (and (eql (d:instance-of y) isi-subject) @@ -2641,6 +2642,7 @@ (bag (get-item-by-id (concatenate 'string *rdf-ns* "Bag"))) (_1 (get-item-by-id (concatenate 'string *rdf-ns* "_1"))) (_2 (get-item-by-id (concatenate 'string *rdf-ns* "_2"))) + (_3 (get-item-by-id (concatenate 'string *rdf-ns* "_3"))) (zauberlehrling (get-item-by-id "http://some.where/poem/Der_Zauberlehrling")) (poem (get-item-by-id (concatenate 'string types "Poem"))) @@ -2685,6 +2687,7 @@ (check-topic bag (concatenate 'string *rdf-ns* "Bag")) (check-topic _1 (concatenate 'string *rdf-ns* "_1")) (check-topic _2 (concatenate 'string *rdf-ns* "_2")) + (check-topic _3 (concatenate 'string *rdf-ns* "_3")) (check-topic zauberlehrling "http://some.where/poem/Der_Zauberlehrling") (check-topic poem (concatenate 'string types "Poem")) (check-topic dateRange (concatenate 'string arcs "dateRange")) Modified: trunk/src/xml/rdf/importer.lisp ============================================================================== --- trunk/src/xml/rdf/importer.lisp (original) +++ trunk/src/xml/rdf/importer.lisp Mon Aug 10 06:48:58 2009 @@ -105,12 +105,13 @@ ; parseType="Collection" -> see also import-arc (let ((fn-xml-base (get-xml-base elem :old-base xml-base)) (fn-xml-lang (get-xml-lang elem :old-lang xml-lang))) - (parse-properties-of-node elem) (let ((about (get-absolute-attribute elem tm-id xml-base "about")) (nodeID (get-ns-attribute elem "nodeID")) (ID (get-absolute-attribute elem tm-id xml-base "ID")) - (UUID (get-ns-attribute elem "UUID" :ns-uri *rdf2tm-ns*)) - (literals (append (get-literals-of-node elem fn-xml-lang) + (UUID (get-ns-attribute elem "UUID" :ns-uri *rdf2tm-ns*))) + (parse-properties-of-node elem (or about nodeID ID UUID)) + + (let ((literals (append (get-literals-of-node elem fn-xml-lang) (get-literals-of-node-content elem tm-id xml-base fn-xml-lang))) (associations (get-associations-of-node-content elem tm-id xml-base)) @@ -144,8 +145,7 @@ :document-id document-id :xml-base xml-base :xml-lang xml-lang) - (remove-node-properties-from-*_n-map* elem) - this)))))) + this))))))) (defun import-arc (elem tm-id start-revision @@ -163,7 +163,7 @@ (and parseType (string/= parseType "Collection"))) (when UUID - (parse-properties-of-node elem) + (parse-properties-of-node elem UUID) (with-tm (start-revision document-id tm-id) (let ((this (get-item-by-id UUID :xtm-id document-id :revision 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 Mon Aug 10 06:48:58 2009 @@ -108,53 +108,73 @@ (condition () nil)))))) -(defun set-_n-name (property _n-counter) - "Returns a name of the form <rdf>_[1-9][0-9]* and adds a tupple - of the form :elem <dom-elem> :type<<rdf>_[1-9][0-9]*> to the - list *_n-map*. - If the dom-elem is already contained in the list only the - <rdf>_[1-9][0-9]* name is returned." - (let ((map-item (find-if #'(lambda(x) - (eql (getf x :elem) property)) - *_n-map*))) - (if map-item - (getf map-item :type) - (let ((new-type-name - (concatenate 'string *rdf-ns* "_" (write-to-string _n-counter)))) - (push (list :elem property - :type new-type-name) - *_n-map*) - new-type-name)))) - - -(defun unset-_n-name (property) - "Deletes the passed property tupple of the *_n-map* list." - (setf *_n-map* (remove-if #'(lambda(x) - (eql (getf x :elem) property)) - *_n-map*))) +(defun find-_n-name-of-property (property) + "Returns the properties name of the form rdf:_n or nil." + (let ((owner + (find-if + #'(lambda(x) + (find-if + #'(lambda(y) + (eql (getf y :elem) property)) + (getf x :props))) + *_n-map*))) + (let ((elem (find-if #'(lambda(x) + (eql (getf x :elem) property)) + (getf owner :props)))) + (when elem + (getf elem :name))))) -(defun remove-node-properties-from-*_n-map* (node) - "Removes all node's properties from the list *_n-map*." - (declare (dom:element node)) - (let ((properties (child-nodes-or-text node :trim t))) - (when properties - (loop for property across properties - do (unset-_n-name property)))) - (dom:map-node-map - #'(lambda(attr) (unset-_n-name attr)) - (dom:attributes node))) + + +(defun find-_n-name (owner-identifier property) + "Returns a name of the form rdf:_n of the property element + when it owns the tagname rdf:li and exists in the *_n-map* list. + Otherwise the return value is nil." + (let ((owner (find-if #'(lambda(x) + (string= (getf x :owner) owner-identifier)) + *_n-map*))) + (when owner + (let ((prop (find-if #'(lambda(x) + (eql (getf x :elem) property)) + (getf owner :props)))) + (getf prop :name))))) + + +(defun set-_n-name (owner-identifier property) + "Sets a new name of the form _n for the passed property element and + adds it to the list *_n-map*. If the property already exists in the + *_n-map* list, there won't be created a new entry but returned the + stored value name." + (let ((name (find-_n-name owner-identifier property))) + (if name + name + (let ((owner (find-if #'(lambda(x) + (string= (getf x :owner) owner-identifier)) + *_n-map*))) + (if owner + (let ((new-name + (concatenate + 'string *rdf-ns* "_" + (write-to-string (+ (length (getf owner :props)) 1))))) + (push (list :elem property + :name new-name) + (getf owner :props)) + new-name) + (progn + (push + (list :owner owner-identifier + :props (list + (list :elem property + :name (concatenate 'string *rdf-ns* "_1")))) + *_n-map*) + "_1")))))) (defun get-type-of-node-name (node) - "Returns the type of the node name (namespace + tagname). - When the node is contained in *_n-map* the corresponding - value of this map will be returned." - (let ((map-item (find-if #'(lambda(x) - (eql (getf x :elem) node)) - *_n-map*))) + (let ((map-item (find-_n-name-of-property node))) (if map-item - (getf map-item :type) + map-item (let ((node-name (get-node-name node)) (node-ns (dom:namespace-uri node))) (concatenate-uri node-ns node-name))))) @@ -258,7 +278,7 @@ :psi (or ID about))))))) -(defun parse-property-name (property _n-counter) +(defun parse-property-name (property owner-identifier) "Parses the given property's name to the known rdf/rdfs nodes and arcs. If the given name es equal to an node an error is thrown otherwise there is displayed a warning when the rdf ord rdfs namespace is used." @@ -286,11 +306,12 @@ err-pref property-name))) (when (and (string= property-ns *rdf-ns*) (string= property-name "li")) - (set-_n-name property _n-counter))) + (set-_n-name owner-identifier property))) + ;(set-_n-name property _n-counter))) t) -(defun parse-property (property _n-counter) +(defun parse-property (property owner-identifier) "Parses a property that represents a rdf-arc." (declare (dom:element property)) (let ((err-pref "From parse-property(): ") @@ -305,7 +326,7 @@ (subClassOf (get-ns-attribute property "subClassOf" :ns-uri *rdfs-ns*)) (literals (get-literals-of-property property nil)) (content (child-nodes-or-text property :trim t))) - (parse-property-name property _n-counter) + (parse-property-name property owner-identifier) (when (and parseType (or nodeID resource datatype type literals)) (error "~awhen rdf:parseType is set the attributes: ~a => ~a are not allowed!" @@ -382,7 +403,7 @@ (string= node-ns *rdfs-ns*))) (and (> (length content) 0) (stringp content))) - (error "~awhen ~a not allowed to own literal content: ~a!" + (error "~awhen property is ~a literal content is not allowed: ~a!" err-pref (if (string= node-name "type") "rdf:type" "rdfs:subClassOf") @@ -398,28 +419,22 @@ t) -(defun parse-properties-of-node (node) +(defun parse-properties-of-node (node owner-identifier) "Parses all node's properties by calling the parse-propery function and sets all rdf:li properties as a tupple to the *_n-map* list." - (let ((child-nodes (child-nodes-or-text node :trim t)) - (_n-counter 0)) + (let ((child-nodes (child-nodes-or-text node :trim t))) + ;(_n-counter 0)) (when (get-ns-attribute node "li") (dom:map-node-map #'(lambda(attr) (when (and (string= (get-node-name attr) "li") (string= (dom:namespace-uri attr) *rdf-ns*)) - (incf _n-counter) - (set-_n-name attr _n-counter))) + (set-_n-name owner-identifier attr))) (dom:attributes node))) (when child-nodes (loop for property across child-nodes - do (let ((prop-name (get-node-name property)) - (prop-ns (dom:namespace-uri node))) - (when (and (string= prop-name "li") - (string= prop-ns *rdf-ns*)) - (incf _n-counter)) - (parse-property property _n-counter))))) + do (parse-property property owner-identifier)))) t)