Author: lgiessmann Date: Mon Aug 31 12:20:06 2009 New Revision: 126 Log: rdf-importer: changed functions that collects resource-information, so properties which contains isidorus contructs are ignored and can be handled separately Modified: trunk/src/constants.lisp trunk/src/xml/rdf/importer.lisp trunk/src/xml/rdf/rdf_tools.lisp Modified: trunk/src/constants.lisp ============================================================================== --- trunk/src/constants.lisp (original) +++ trunk/src/constants.lisp Mon Aug 31 12:20:06 2009 @@ -50,7 +50,10 @@ :*tm2rdf-role-type-uri* :*tm2rdf-role-property* :*tm2rdf-association-type-uri* - :*tm2rdf-associaiton-property*)) + :*tm2rdf-associaiton-property* + :*tm2rdf-subjectIdentifier-property* + :*tm2rdf-itemIdentity-property* + :*tm2rdf-subjectLocator-property*)) (in-package :constants) @@ -135,3 +138,9 @@ (defparameter *tm2rdf-association-type-uri* (concatenate 'string *tm2rdf-ns* "Association")) (defparameter *tm2rdf-association-property* (concatenate 'string *tm2rdf-ns* "association")) + +(defparameter *tm2rdf-subjectIdentifier-property* (concatenate 'string *tm2rdf-ns* "subjectIdentifier")) + +(defparameter *tm2rdf-subjectLocator-property* (concatenate 'string *tm2rdf-ns* "subjectLocator")) + +(defparameter *tm2rdf-itemIdentity-property* (concatenate 'string *tm2rdf-ns* "itemIdentity")) Modified: trunk/src/xml/rdf/importer.lisp ============================================================================== --- trunk/src/xml/rdf/importer.lisp (original) +++ trunk/src/xml/rdf/importer.lisp Mon Aug 31 12:20:06 2009 @@ -110,6 +110,12 @@ (types (get-types-of-node elem tm-id :parent-xml-base xml-base)) (super-classes (get-super-classes-of-node-content elem tm-id xml-base))) + ;TODO: collect isidorus' subjectIdentifiers, itemIdentities, + ; subjectLocators, names and occurrences + ; add the collected constructs to the topic-stub + + ;TODO: collect associations and association roles and create the + ; corresponding constructs and stops the recusrion (with-tm (start-revision document-id tm-id) (let ((this (make-topic-stub @@ -176,6 +182,9 @@ (super-classes (get-super-classes-of-node-content elem tm-id xml-base))) + ;TODO: collect isidorus' subjectIdentifiers, itemIdentities, + ; subjectLocators, names and occurrences + ; add the collected constructs to the topic-stub (make-literals this literals tm-id start-revision :document-id document-id) (make-associations this associations xml-importer::tm @@ -580,7 +589,7 @@ "Returns a list of literals that is produced of a node's content." (declare (dom:element node)) (tm-id-p tm-id "get-literals-of-noode-content") - (let ((properties (child-nodes-or-text node :trim t)) + (let ((properties (non-isidorus-child-nodes-or-text node :trim t)) (fn-xml-base (get-xml-base node :old-base xml-base)) (fn-xml-lang (get-xml-lang node :old-lang xml-lang))) (let ((literals @@ -605,8 +614,6 @@ (not (or prop-literals type)) (string/= parseType "Collection") (string/= parseType "Resource"))) - - collect (let ((content (child-nodes-or-text property)) (ID (get-absolute-attribute property tm-id fn-xml-base "ID")) @@ -651,8 +658,8 @@ :ID nil)) nil)) (content-types - (when (child-nodes-or-text node :trim t) - (loop for child across (child-nodes-or-text node :trim t) + (when (non-isidorus-child-nodes-or-text node :trim t) + (loop for child across (non-isidorus-child-nodes-or-text node :trim t) when (and (string= (dom:namespace-uri child) *rdf-ns*) (string= (get-node-name child) "type")) collect (let ((nodeID (get-ns-attribute child "nodeID")) @@ -766,7 +773,7 @@ "Returns a list of super-classes and IDs." (declare (dom:element node)) (tm-id-p tm-id "get-super-classes-of-node-content") - (let ((content (child-nodes-or-text node :trim t)) + (let ((content (non-isidorus-child-nodes-or-text node :trim t)) (fn-xml-base (get-xml-base node :old-base xml-base))) (when content (loop for property across content @@ -799,7 +806,7 @@ (defun get-associations-of-node-content (node tm-id xml-base) "Returns a list of associations with a type, value and ID member." (declare (dom:element node)) - (let ((properties (child-nodes-or-text node :trim t)) + (let ((properties (non-isidorus-child-nodes-or-text node :trim t)) (fn-xml-base (get-xml-base node :old-base xml-base))) (loop for property across properties when (let ((prop-name (get-node-name property)) @@ -859,7 +866,7 @@ "Calls the next function that handles all DOM child elements of the passed element as arcs." (declare (dom:element node)) - (let ((content (child-nodes-or-text node :trim t)) + (let ((content (non-isidorus-child-nodes-or-text node :trim t)) (err-pref "From make-recursion-from-node(): ") (fn-xml-base (get-xml-base node :old-base xml-base)) (fn-xml-lang (get-xml-lang node :old-lang xml-lang))) @@ -878,7 +885,7 @@ (declare (dom:element arc)) (let ((fn-xml-base (get-xml-base arc :old-base xml-base)) (fn-xml-lang (get-xml-lang arc :old-lang xml-lang)) - (content (child-nodes-or-text arc)) + (content (non-isidorus-child-nodes-or-text arc)) (parseType (get-ns-attribute arc "parseType"))) (let ((datatype (get-absolute-attribute arc tm-id xml-base "datatype")) (type (get-absolute-attribute arc tm-id xml-base "type")) 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 31 12:20:06 2009 @@ -42,7 +42,10 @@ *tm2rdf-role-type-uri* *tm2rdf-role-property* *tm2rdf-association-type-uri* - *tm2rdf-association-property*) + *tm2rdf-association-property* + *tm2rdf-subjectIdentifier-property* + *tm2rdf-itemIdentity-property* + *tm2rdf-subjectLocator-property*) (:import-from :xml-constants *rdf_core_psis.xtm* *core_psis.xtm*) @@ -662,4 +665,26 @@ (when (and (= (length content) 1) (not (stringp content))) (type-p (elt content 0) type tm-id - :parent-xml-base xml-base)))))))))) \ No newline at end of file + :parent-xml-base xml-base)))))))))) + + +(defun non-isidorus-child-nodes-or-text (elem &key (trim nil)) + "Returns a list of node elements that are no isidorus properties, e.g. + isidorus:name, string-content or nil." + (let ((content (child-nodes-or-text elem :trim trim))) + (if (or (not content) + (stringp content)) + content + (remove-if #'(lambda(x) + (let ((x-uri (if (dom:namespace-uri x) + (concatenate-uri (dom:namespace-uri x) + (get-node-name x)) + (get-node-name x)))) + (or (string= x-uri *tm2rdf-name-property*) + (string= x-uri *tm2rdf-variant-property*) + (string= x-uri *tm2rdf-occurrence-property*) + (string= x-uri *tm2rdf-role-property*) + (string= x-uri *tm2rdf-subjectIdentifier-property*) + (string= x-uri *tm2rdf-itemIdentity-property*) + (string= x-uri *tm2rdf-subjectLocator-property*)))) + content)))) \ No newline at end of file