[isidorus-cvs] r126 - in trunk/src: . xml/rdf
Lukas Giessmann
lgiessmann at common-lisp.net
Mon Aug 31 16:20:06 UTC 2009
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
More information about the Isidorus-cvs
mailing list