Changeset 99 for trunk/src/xml/rdf

Timestamp:

07/30/09 14:25:23 (16 years ago)

Author:

lgiessmann

Message:

added rdf:li handling for to rdf-importer

Location:

trunk/src/xml/rdf

Files:

• importer.lisp (modified) (5 diffs)
• rdf_tools.lisp (modified) (6 diffs)

trunk/src/xml/rdf/importer.lisp ¶

@@ -22 +22 @@
                      &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")
@@ -32 +33 @@
       (elephant:open-store
        (get-store-spec repository-path)))
-    (import-dom rdf-dom :tm-id tm-id :document-id document-id)))
-
-
-
-(defun import-dom (rdf-dom &key (tm-id nil) (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 revision &key (tm-id nil) (document-id *document-id*))
   (tm-id-p tm-id "import-dom")
   (let ((xml-base (get-xml-base rdf-dom))
@@ -48 +49 @@
           (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"))
@@ -75 +73 @@
                          (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))))
 
 
@@ -127 +142 @@
                                   :datatype datatype)))))))
       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)))
 
 

trunk/src/xml/rdf/rdf_tools.lisp ¶

@@ -38 +38 @@
                 push-string
                 node-to-string)
+  (:import-from :datamodel
+                get-revision)
   (:import-from :xml-importer
                 get-uuid
@@ -60 +62 @@
                                 "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)))))
 
 
@@ -170 +225 @@
 
 
-(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
@@ -194 +249 @@
       (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))
@@ -213 +271 @@
         (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))
@@ -303 +361 @@
 
 
+(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*))