Author: lgiessmann Date: Thu Jul 30 10:25:23 2009 New Revision: 99
Log: added rdf:li handling for to rdf-importer
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 Thu Jul 30 10:25:23 2009 @@ -35,7 +35,8 @@ :test-get-types :test-get-literals-of-content :test-get-super-classes-of-node-content - :test-get-associations-of-node-content)) + :test-get-associations-of-node-content + :test-parse-properties-of-node))
(declaim (optimize (debug 3) (speed 0) (safety 3) (space 0) (compilation-speed 0)))
@@ -258,7 +259,7 @@ (text-node (dom:create-text-node dom-1 "new text node"))) (is (= (length children) 19)) (loop for property across children - do (is-true (rdf-importer::parse-property property))) + do (is-true (rdf-importer::parse-property property 0))) (dotimes (i (length children)) (if (or (= i 0) (= i 1) (= i 3) (= i 4) (= i 9) (= i 17)) (is-true (get-ns-attribute (elt children i) "UUID" @@ -267,70 +268,70 @@ :ns-uri *rdf2tm-ns*)))) (let ((prop (elt children 0))) (dom:set-attribute-ns prop *rdf-ns* "parseType" "Unknown") - (signals error (rdf-importer::parse-property prop)) + (signals error (rdf-importer::parse-property prop 0)) (dom:set-attribute-ns prop *rdf-ns* "parseType" "Resource") - (is-true (rdf-importer::parse-property prop)) + (is-true (rdf-importer::parse-property prop 0)) (dom:set-attribute-ns prop *rdf-ns* "ID" "newID") - (is-true (rdf-importer::parse-property prop)) + (is-true (rdf-importer::parse-property prop 0)) (dom:set-attribute-ns prop *rdf-ns* "bad" "bad") - (signals error (rdf-importer::parse-property prop)) + (signals error (rdf-importer::parse-property prop 0)) (dom:remove-attribute-ns prop *rdf-ns* "bad") - (is-true (rdf-importer::parse-property prop)) + (is-true (rdf-importer::parse-property prop 0)) (dom:append-child prop text-node) - (signals error (rdf-importer::parse-property prop)) + (signals error (rdf-importer::parse-property prop 0)) (dom:remove-child prop text-node) - (is-true (rdf-importer::parse-property prop))) + (is-true (rdf-importer::parse-property prop 0))) (let ((prop (elt children 1))) (dom:set-attribute-ns prop *rdf-ns* "nodeID" "bad") - (signals error (rdf-importer::parse-property prop)) + (signals error (rdf-importer::parse-property prop 0)) (dom:remove-attribute-ns prop *rdf-ns* "nodeID") - (is-true (rdf-importer::parse-property prop)) + (is-true (rdf-importer::parse-property prop 0)) (dom:set-attribute-ns prop *rdf-ns* "ID" "newID") - (is-true (rdf-importer::parse-property prop)) + (is-true (rdf-importer::parse-property prop 0)) (dom:append-child prop text-node) - (signals error (rdf-importer::parse-property prop)) + (signals error (rdf-importer::parse-property prop 0)) (dom:remove-child prop text-node) - (is-true (rdf-importer::parse-property prop))) + (is-true (rdf-importer::parse-property prop 0))) (let ((prop (elt children 3))) (dom:append-child prop text-node) - (signals error (rdf-importer::parse-property prop)) + (signals error (rdf-importer::parse-property prop 0)) (dom:remove-child prop text-node) - (is-true (rdf-importer::parse-property prop))) + (is-true (rdf-importer::parse-property prop 0))) (let ((prop (elt children 4))) (dom:append-child prop text-node) - (signals error (rdf-importer::parse-property prop)) + (signals error (rdf-importer::parse-property prop 0)) (dom:remove-child prop text-node) - (is-true (rdf-importer::parse-property prop))) + (is-true (rdf-importer::parse-property prop 0))) (let ((prop (elt children 5))) (dom:set-attribute-ns prop *rdf-ns* "type" "newType") - (is-true (rdf-importer::parse-property prop)) + (is-true (rdf-importer::parse-property prop 0)) (dom:set-attribute-ns prop *rdf-ns* "unknown" "unknown") - (is-true (rdf-importer::parse-property prop)) + (is-true (rdf-importer::parse-property prop 0)) (dom:append-child prop text-node) - (signals error (rdf-importer::parse-property prop)) + (signals error (rdf-importer::parse-property prop 0)) (dom:remove-child prop text-node) - (is-true (rdf-importer::parse-property prop)) + (is-true (rdf-importer::parse-property prop 0)) (dom:remove-attribute-ns prop *rdf-ns* "unknown") - (is-true (rdf-importer::parse-property prop)) + (is-true (rdf-importer::parse-property prop 0)) (dom:append-child prop text-node) - (signals error (rdf-importer::parse-property prop)) + (signals error (rdf-importer::parse-property prop 0)) (dom:remove-child prop text-node) - (is-true (rdf-importer::parse-property prop))) + (is-true (rdf-importer::parse-property prop 0))) (let ((prop (elt children 10))) (dom:set-attribute-ns prop *rdf-ns* "type" "newType") - (signals error (rdf-importer::parse-property prop)) + (signals error (rdf-importer::parse-property prop 0)) (dom:remove-attribute-ns prop *rdf-ns* "type") - (is-true (rdf-importer::parse-property prop)) + (is-true (rdf-importer::parse-property prop 0)) (dom:set-attribute-ns prop *rdf-ns* "nodeID" "newNodeID") - (signals error (rdf-importer::parse-property prop)) + (signals error (rdf-importer::parse-property prop 0)) (dom:remove-attribute-ns prop *rdf-ns* "nodeID") - (is-true (rdf-importer::parse-property prop)) + (is-true (rdf-importer::parse-property prop 0)) (dom:set-attribute-ns prop *rdf-ns* "resource" "newResource") - (signals error (rdf-importer::parse-property prop)) + (signals error (rdf-importer::parse-property prop 0)) (dom:remove-attribute-ns prop *rdf-ns* "resource") - (is-true (rdf-importer::parse-property prop)) + (is-true (rdf-importer::parse-property prop 0)) (dom:set-attribute-ns prop *rdf-ns* "ID" "newID") - (is-true (rdf-importer::parse-property prop)))))))) + (is-true (rdf-importer::parse-property prop 0))))))))
(test test-get-types @@ -382,7 +383,7 @@ (is-false (absolute-uri-p nil)) (let ((node (elt (dom:child-nodes dom-1) 0))) (loop for property across (rdf-importer::child-nodes-or-text node) - do (rdf-importer::parse-property property)) + do (rdf-importer::parse-property property 0)) (let ((types (append (list (list @@ -477,7 +478,7 @@ (let ((node (elt (dom:child-nodes dom-1) 0))) (dotimes (iter (length (dom:child-nodes node))) (is-true (rdf-importer::parse-property - (elt (dom:child-nodes node) iter)))) + (elt (dom:child-nodes node) iter) 0))) (let ((literals (rdf-importer::get-literals-of-node-content node tm-id nil nil))) (is (= (length literals) 7)) @@ -598,7 +599,7 @@ (is-true node) (is-true (rdf-importer::parse-node node)) (loop for property across (rdf-importer::child-nodes-or-text node) - do (is-true (rdf-importer::parse-property property))) + do (is-true (rdf-importer::parse-property property 0))) (let ((super-classes (rdf-importer::get-super-classes-of-node-content node tm-id xml-base))) (is (= (length super-classes) 8)) @@ -637,7 +638,7 @@ (dom:append-child (elt (rdf-importer::child-nodes-or-text node) 1) (dom:create-text-node dom-1 "new text")) (signals error (rdf-importer::parse-property - (elt (rdf-importer::child-nodes-or-text node) 1)))))))) + (elt (rdf-importer::child-nodes-or-text node) 1) 0)))))))
(test test-get-associations-of-node-content @@ -685,7 +686,7 @@ (is (= (length (dom:child-nodes dom-1)) 1)) (let ((node (elt (dom:child-nodes dom-1) 0))) (loop for property across (rdf-importer::child-nodes-or-text node) - do (is-true (rdf-importer::parse-property property))) + do (is-true (rdf-importer::parse-property property 0))) (let ((associations (rdf-importer::get-associations-of-node-content node tm-id nil))) (is (= (length associations) 12)) @@ -774,6 +775,44 @@ associations)))))))
+(test test-parse-properties-of-node + (let ((doc-1 + (concatenate 'string "<rdf:Description xmlns:rdf="" *rdf-ns* "" " + "xmlns:arcs="http://test/arcs/%5C" " + "xml:base="http://xml-base/first%5C" " + "rdf:about="resource" rdf:type="attr-type">" + "<rdf:li rdf:resource="anyType" />" + "rdf:li </rdf:li>" + "<rdf:li rdf:nodeID="anyClass" />" + "rdf:li </rdf:li>" + "<rdf:li rdf:resource="assoc-1"/>" + "<rdf:li rdf:type="assoc-2-type">" + " </rdf:li>" + "<rdf:li rdf:parseType="Literal" />" + "<rdf:_123 arcs:arc5="text-arc5" />" + "<rdf:arc6 rdf:ID="rdfID-3"/>" + "<rdf:arcs rdf:ID="rdfID-4"/>" + "</rdf:Description>"))) + (let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder)))) + (is-true dom-1) + (is (= (length (dom:child-nodes dom-1)))) + (let ((node (elt (dom:child-nodes dom-1) 0))) + (is-true (rdf-importer::parse-properties-of-node node)) + (is (= (length rdf-importer::*_n-map*) 7)) + (format t "~a~%" rdf-importer::*_n-map*) + (dotimes (iter (length rdf-importer::*_n-map*)) + (is-true (find-if + #'(lambda(x) + (string= (getf x :type) + (concatenate + 'string *rdf-ns* "_" + (write-to-string (+ 1 iter))))) + rdf-importer::*_n-map*))) + (rdf-importer::remove-node-properties-from-*_n-map* node) + (is (= (length rdf-importer::*_n-map*) 0)))))) + + + (defun run-rdf-importer-tests() (it.bese.fiveam:run! 'test-get-literals-of-node) (it.bese.fiveam:run! 'test-parse-node) @@ -782,4 +821,5 @@ (it.bese.fiveam:run! 'test-get-types) (it.bese.fiveam:run! 'test-get-literals-of-content) (it.bese.fiveam:run! 'test-get-super-classes-of-node-content) - (it.bese.fiveam:run! 'test-get-associations-of-node-content)) \ No newline at end of file + (it.bese.fiveam:run! 'test-get-associations-of-node-content) + (it.bese.fiveam:run! 'test-parse-properties-of-node)) \ No newline at end of file
Modified: trunk/src/xml/rdf/importer.lisp ============================================================================== --- trunk/src/xml/rdf/importer.lisp (original) +++ trunk/src/xml/rdf/importer.lisp Thu Jul 30 10:25:23 2009 @@ -21,7 +21,8 @@ (defun rdf-importer (rdf-xml-path repository-path &key (tm-id nil) - (document-id (get-uuid))) + (document-id (get-uuid)) + (revision (get-revision))) (setf *document-id* document-id) (tm-id-p tm-id "rdf-importer") (let ((rdf-dom @@ -31,11 +32,11 @@ (unless elephant:*store-controller* (elephant:open-store (get-store-spec repository-path))) - (import-dom rdf-dom :tm-id tm-id :document-id document-id))) + (import-dom rdf-dom revision :tm-id tm-id :document-id document-id)) + (setf *_n-map* nil))
- -(defun import-dom (rdf-dom &key (tm-id nil) (document-id *document-id*)) +(defun import-dom (rdf-dom revision &key (tm-id nil) (document-id *document-id*)) (tm-id-p tm-id "import-dom") (let ((xml-base (get-xml-base rdf-dom)) (xml-lang (get-xml-lang rdf-dom)) @@ -47,21 +48,18 @@ (let ((children (child-nodes-or-text rdf-dom))) (when children (loop for child across children - do (import-node child tm-id :document-id document-id + do (import-node child tm-id revision :document-id document-id :xml-base xml-base :xml-lang xml-lang)))) - (import-node rdf-dom tm-id :document-id document-id + (import-node rdf-dom tm-id revision :document-id document-id :xml-base xml-base :xml-lang xml-lang))))
-(defun import-node (elem tm-id &key (document-id *document-id*) +(defun import-node (elem tm-id revision &key (document-id *document-id*) (xml-base nil) (xml-lang nil)) - (declare (ignorable document-id)) ;TODO: remove (tm-id-p tm-id "import-node") (parse-node elem) (let ((fn-xml-base (get-xml-base elem :old-base xml-base))) - (when (child-nodes-or-text elem) - (loop for property across (child-nodes-or-text elem) - do (parse-property property))) + (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")) @@ -74,10 +72,27 @@ (list :value (get-type-of-node-name elem) :ID nil)) (get-types-of-node-content elem tm-id fn-xml-base))) (super-classes (get-super-classes-of-node-content elem tm-id xml-base))) - ;TODO: create elephant-objects - ;TODO: recursion on all nodes/arcs - (declare (ignorable about nodeID ID UUID literals associations ;TODO: remove - types super-classes))))) + + ;TODO: + ;get-topic by topic id + ;make psis + ;if no ones exist create one with topic id + ;add psis + ;make nametype topic with topic id + ;make instance-of associations + ;make topictype topics with topic id + ;make super-sub-class assoications + ;make and add names + ;make occurrencetype topics with topic id + ;make and add occurrences + ;make referenced topic with topic id + ;make and add associations + + + ;TODO: start recursion ... + (remove-node-properties-from-*_n-map* elem) + (or tm-id document-id revision about nodeID ID UUID literals ;TODO: remove + associations types super-classes))))
(defun get-literals-of-node-content (node tm-id xml-base xml-lang) @@ -128,13 +143,6 @@ literals)))
-(defun get-type-of-node-name (node) - "Returns the type of the node name (namespace + tagname)." - (let ((node-name (get-node-name node)) - (node-ns (dom:namespace-uri node))) - (concatenate-uri node-ns node-name))) - - (defun get-types-of-node-content (node tm-id xml-base) "Returns a list of type-uris that corresponds to the node's content or attributes."
Modified: trunk/src/xml/rdf/rdf_tools.lisp ============================================================================== --- trunk/src/xml/rdf/rdf_tools.lisp (original) +++ trunk/src/xml/rdf/rdf_tools.lisp Thu Jul 30 10:25:23 2009 @@ -37,6 +37,8 @@ concatenate-uri push-string node-to-string) + (:import-from :datamodel + get-revision) (:import-from :xml-importer get-uuid get-store-spec) @@ -59,18 +61,71 @@ "range" "range" "label" "comment" "member" "seeAlso" "isDefinedBy"))
-(defun _n-p (node-name) +(defvar *_n-map* nil) + + +(defun _n-p (node) "Returns t if the given value is of the form _[0-9]+" - (when (and node-name - (> (length node-name) 0) - (eql (elt node-name 0) #_)) - (let ((rest - (subseq node-name 1 (length node-name)))) - (declare (string node-name)) - (handler-case (let ((int - (parse-integer rest))) - int) - (condition () nil))))) + (let ((node-name (get-node-name node))) + (when (and node-name + (> (length node-name) 0) + (eql (elt node-name 0) #_)) + (let ((rest + (subseq node-name 1 (length node-name)))) + (declare (string node-name)) + (handler-case (let ((int + (parse-integer rest))) + int) + (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) + (setf *_n-map* (remove-if + #'(lambda(x) + (eql (getf x :elem) property)) + *_n-map*))) + + +(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))) + (when properties + (loop for property across properties + do (unset-_n-name property))))) + + +(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*))) + (if map-item + (getf map-item :type) + (let ((node-name (get-node-name node)) + (node-ns (dom:namespace-uri node))) + (concatenate-uri node-ns node-name)))))
(defun parse-node-name (node) @@ -169,7 +224,7 @@ (or ID nodeID about UUID))))))
-(defun parse-property-name (property) +(defun parse-property-name (property _n-counter) "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." @@ -193,11 +248,14 @@ err-pref property-name)) (unless (find property-name *rdfs-properties* :test #'string=) (format t "~aWarning: rdfs:~a is not a known rdfs:type!~%" - err-pref property-name)))) + err-pref property-name))) + (when (and (string= property-ns *rdf-ns*) + (string= property-name "li")) + (set-_n-name property _n-counter))) t)
-(defun parse-property (property) +(defun parse-property (property _n-counter) "Parses a property that represents a rdf-arc." (declare (dom:element property)) (let ((err-pref "From parse-property(): ") @@ -212,7 +270,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) + (parse-property-name property _n-counter) (when (and parseType (or nodeID resource datatype type literals)) (error "~awhen rdf:parseType is set the attributes: ~a => ~a are not allowed!" @@ -302,6 +360,20 @@ t)
+(defun parse-properties-of-node (node) + (let ((child-nodes (child-nodes-or-text node)) + (_n-counter 0)) + (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))))) + t) + + (defun get-absolute-attribute (elem tm-id xml-base attr-name &key (ns-uri *rdf-ns*)) "Returns an absolute 'attribute' or nil."