From lgiessmann at common-lisp.net  Mon Aug  3 17:08:12 2009
From: lgiessmann at common-lisp.net (Lukas Giessmann)
Date: Mon, 03 Aug 2009 13:08:12 -0400
Subject: [isidorus-cvs] r103 - in trunk/src: unit_tests xml/rdf xml/xtm
Message-ID: <E1MY11A-0001Yl-K4@common-lisp.net>

Author: lgiessmann
Date: Mon Aug  3 13:08:11 2009
New Revision: 103

Log:
added some unit tests for the rdf-importer and fixed several bugs

Modified:
   trunk/src/unit_tests/rdf_importer_test.lisp
   trunk/src/xml/rdf/importer.lisp
   trunk/src/xml/rdf/rdf_core_psis.xtm
   trunk/src/xml/rdf/rdf_tools.lisp
   trunk/src/xml/xtm/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  3 13:08:11 2009
@@ -19,7 +19,19 @@
 		*rdfs-ns*
 		*rdf2tm-ns*
 		*xml-ns*
-		*xml-string*)
+		*xml-string*
+		*instance-psi*
+		*type-psi*
+		*type-instance-psi*
+		*subtype-psi*
+		*supertype-psi*
+		*supertype-subtype-psi*
+		*xml-string*
+		*rdf2tm-object*
+		*rdf2tm-subject*
+		*rdf-subject*
+		*rdf-object*
+		*rdf-predicate*)
   (:import-from :xml-tools
                 xpath-child-elems-by-qname
 		xpath-single-child-elem-by-qname
@@ -36,7 +48,9 @@
 	   :test-get-literals-of-content
 	   :test-get-super-classes-of-node-content
 	   :test-get-associations-of-node-content
-	   :test-parse-properties-of-node))
+	   :test-parse-properties-of-node
+	   :test-import-node-1
+	   :test-import-node-reification))
 
 (declaim (optimize (debug 3) (speed 0) (safety 3) (space 0) (compilation-speed 0)))
 
@@ -49,6 +63,16 @@
 (in-suite rdf-importer-test)
 
 
+(defun rdf-init-db (&key (db-dir "data_base") (start-revision (get-revision)))
+  "Empties the data base files and initializes isidorus for rdf."
+  (when elephant:*store-controller*
+    (elephant:close-store))
+  (clean-out-db db-dir)
+  (elephant:open-store (xml-importer:get-store-spec db-dir))
+  (xml-importer:init-isidorus start-revision)
+  (rdf-importer:init-rdf-module start-revision))
+
+
 (test test-get-literals-of-node
   "Tests the helper function get-literals-of-node."
   (let ((doc-1
@@ -967,7 +991,221 @@
 	(rdf-importer::remove-node-properties-from-*_n-map* node)
 	(is (= (length rdf-importer::*_n-map*) 0))))))
 
+
+(test test-import-node-1
+  "Tests the function import-node non-recursively."
+  (let ((db-dir "data_base")
+	(tm-id "http://test-tm/")
+	(revision-1 100)
+	(revision-2 200)
+	(revision-3 300)
+	(document-id "doc-id")
+	(doc-1
+	 (concatenate 'string "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" "
+		      "xmlns:arcs=\"http://test/arcs/\" "
+		      "xmlns:rdfs=\"" *rdfs-ns* "\">"
+		      "<rdf:Description rdf:about=\"first-node\">"
+		      "<rdf:type rdf:resource=\"first-type\" />"
+		      "</rdf:Description>"
+		      "<rdf:Description rdf:type=\"second-type\" "
+		      "rdf:nodeID=\"second-node\">"
+		      "<rdfs:subClassOf>"
+		      "<rdf:Description rdf:ID=\"third-node\" />"
+		      "</rdfs:subClassOf>"
+		      "</rdf:Description>"
+		      "<rdf:Description arcs:arc1=\"arc-1\">"
+		      "<arcs:arc2 rdf:datatype=\"dt\">arc-2</arcs:arc2>"
+		      "</rdf:Description>"
+		      "<rdf:Description rdf:about=\"fourth-node\">"
+		      "<arcs:arc3 rdf:parseType=\"Literal\"><root>"
+		      "<content type=\"anyContent\">content</content>"
+		      "</root></arcs:arc3>"
+		      "</rdf:Description>"
+		      "<rdf:Description rdf:ID=\"fifth-node\">"
+		      "<arcs:arc4 rdf:parseType=\"Resource\">"
+		      "<arcs:arc5 rdf:resource=\"arc-5\" />"
+		      "</arcs:arc4>"
+		      "</rdf:Description>"
+		      "</rdf:RDF>")))
+    (let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder))))
+      (is-true dom-1)
+      (is (= (length (dom:child-nodes dom-1)) 1))
+      (let ((rdf-node (elt (dom:child-nodes dom-1) 0)))
+	(is (= (length (dom:child-nodes rdf-node)) 5))
+	(let ((node (elt (dom:child-nodes rdf-node) 0)))
+	  (rdf-init-db :db-dir db-dir :start-revision revision-1)
+	  (rdf-importer::import-node node tm-id revision-2
+				     :document-id document-id)
+	  (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 20))
+	  (let ((first-node (get-item-by-id "http://test-tm/first-node"
+					    :xtm-id document-id))
+		(first-type (get-item-by-id "http://test-tm/first-type"
+					    :xtm-id document-id)))
+	    (is-true first-node)
+	    (is (= (length (d::versions first-node)) 1))
+	    (is (= (d::start-revision (first (d::versions first-node)))
+		   revision-2))
+	    (is (= (d::end-revision (first (d::versions first-node))) 0))
+	    (is-true first-type)
+	    (is (= (length (d:player-in-roles first-node)) 1))
+	    (is (= (length (d:player-in-roles first-type)) 1))
+	    (let ((instance-role
+		   (first (d:player-in-roles first-node)))
+		  (type-role
+		   (first (d:player-in-roles first-type)))
+		  (type-assoc
+		   (d:parent (first (d:player-in-roles first-node)))))
+	      (is (= (length (d::versions type-assoc)) 1))
+	      (is (= (d::start-revision (first (d::versions type-assoc)))
+		     revision-2))
+	      (is (eql (d:instance-of instance-role)
+		       (d:get-item-by-psi *instance-psi*)))
+	      (is (eql (d:instance-of type-role)
+		       (d:get-item-by-psi *type-psi*)))
+	      (is (eql (d:instance-of type-assoc)
+		       (d:get-item-by-psi *type-instance-psi*)))
+	      (is (= (length (d:roles type-assoc)) 2))
+	      (is (= (length (d:psis first-node)) 1))
+	      (is (= (length (d:psis first-type)) 1))
+	      (is (string= (d:uri (first (d:psis first-node)))
+			   "http://test-tm/first-node"))
+	      (is (string= (d:uri (first (d:psis first-type)))
+			   "http://test-tm/first-type"))
+	      (is (= (length (elephant:get-instances-by-class 'd:OccurrenceC))))
+	      (is (= (length (elephant:get-instances-by-class 'd:NameC))))
+	      (is (= (length (elephant:get-instances-by-class 'd:VariantC)))))
+	    (dotimes (iter (length (dom:child-nodes rdf-node)))
+	      (rdf-importer::import-node (elt (dom:child-nodes rdf-node) iter)
+					 tm-id revision-3
+					 :document-id document-id))
+	    (let ((first-node (get-item-by-id "http://test-tm/first-node"
+					      :xtm-id document-id))
+		  (first-type (get-item-by-id "http://test-tm/first-type"
+					      :xtm-id document-id))
+		  (second-node (get-item-by-id "second-node"
+					       :xtm-id document-id))
+		  (second-type (get-item-by-id "http://test-tm/second-type"
+					       :xtm-id document-id))
+		  (third-node (get-item-by-id "http://test-tm#third-node"
+					      :xtm-id document-id)))
+	      (is-true second-node)
+	      (is-false (d:psis second-node))
+	      (is-false (d:occurrences second-node))
+	      (is-false (d:names second-node))
+	      (is-true first-node)
+	      (is (= (length (d::versions first-node)) 2))
+	      (is-true (find-if #'(lambda(x)
+				    (and (= (d::start-revision x) revision-2)
+					 (= (d::end-revision x) revision-3)))
+				(d::versions first-node)))
+	      (is-true (find-if #'(lambda(x)
+				    (and (= (d::start-revision x) revision-3)
+					 (= (d::end-revision x) 0)))
+				(d::versions first-node)))
+	      (let ((instance-role
+		     (first (d:player-in-roles first-node)))
+		    (type-role
+		     (first (d:player-in-roles first-type)))
+		    (type-assoc
+		     (d:parent (first (d:player-in-roles first-node))))
+		    (type-topic (get-item-by-psi *type-psi*))
+		    (instance-topic (get-item-by-psi *instance-psi*))
+		    (type-instance-topic (get-item-by-psi *type-instance-psi*))
+		    (supertype-topic (get-item-by-psi *supertype-psi*))
+		    (subtype-topic (get-item-by-psi *subtype-psi*))
+		    (supertype-subtype-topic
+		     (get-item-by-psi *supertype-subtype-psi*))
+		    (arc2-occurrence (elephant:get-instance-by-value
+				      'd:OccurrenceC 'd:charvalue "arc-2"))
+		    (arc3-occurrence
+		     (elephant:get-instance-by-value
+		      'd:OccurrenceC 'd:charvalue
+		      "<root><content type=\"anyContent\">content</content></root>"))
+		    (fifth-node (d:get-item-by-id "http://test-tm#fifth-node"
+						  :xtm-id document-id)))
+		(is (eql (d:instance-of instance-role)
+			 (d:get-item-by-psi *instance-psi*)))
+		(is (eql (d:instance-of type-role)
+			 (d:get-item-by-psi *type-psi*)))
+		(is (eql (d:instance-of type-assoc)
+			 (d:get-item-by-psi *type-instance-psi*)))
+		(is (= (length (d:roles type-assoc)) 2))
+		(is (= (length (d:psis first-node)) 1))
+		(is (= (length (d:psis first-type)) 1))
+		(is (= (length (d::versions type-assoc)) 1))
+		(is (= (length (d:player-in-roles second-node)) 2))
+		(is-true (find-if
+			  #'(lambda(x)
+			      (and (eql (d:instance-of x) instance-topic)
+				   (eql (d:instance-of (d:parent x) )
+					type-instance-topic)))
+			  (d:player-in-roles second-node)))
+		(is-true (find-if
+			  #'(lambda(x)
+			      (and (eql (d:instance-of x) subtype-topic)
+				   (eql (d:instance-of (d:parent x) )
+					supertype-subtype-topic)))
+			  (d:player-in-roles second-node)))
+		(is-true (find-if
+			  #'(lambda(x)
+			      (and (eql (d:instance-of x) type-topic)
+				   (eql (d:instance-of (d:parent x) )
+					type-instance-topic)))
+			  (d:player-in-roles second-type)))
+		(is-true (find-if
+			  #'(lambda(x)
+			      (and (eql (d:instance-of x) supertype-topic)
+				   (eql (d:instance-of (d:parent x) )
+					supertype-subtype-topic)))
+			  (d:player-in-roles third-node)))
+		(is-true arc2-occurrence)
+		(is (string= (d:datatype arc2-occurrence) "http://test-tm/dt"))
+		(is-false (d:psis (d:topic arc2-occurrence)))
+		(is (= (length (d::versions (d:topic arc2-occurrence))) 1))
+		(is (= (d::start-revision
+			(first (d::versions (d:topic arc2-occurrence))))
+		       revision-3))
+		(is (= (d::end-revision
+			(first (d::versions (d:topic arc2-occurrence)))) 0))
+		(is-true arc3-occurrence)
+		(is (= (length (d:psis (d:topic arc3-occurrence)))))
+		(is (string= (d:uri (first (d:psis (d:topic arc3-occurrence))))
+			     "http://test-tm/fourth-node"))
+		(is (string= (d:datatype arc3-occurrence)
+			     *xml-string*))
+		(is-true fifth-node)
+		(is (= (length (d:psis fifth-node)) 1))
+		(is (string= (d:uri (first (d:psis fifth-node)))
+			     "http://test-tm#fifth-node"))
+		(is-false (d:occurrences fifth-node))
+		(is-false (d:names fifth-node))
+		(is (= (length (d:player-in-roles fifth-node))))
+		(let ((assoc (d:parent (first (d:player-in-roles
+					       fifth-node)))))
+		  (is-true assoc)
+		  (let ((object-role
+			 (find-if
+			  #'(lambda(role)
+			      (eql (d:instance-of role)
+				   (d:get-item-by-psi *rdf2tm-object*)))
+			  (d:roles assoc)))
+			(subject-role
+			 (find-if
+			  #'(lambda(role)
+			      (eql (d:instance-of role)
+				   (d:get-item-by-psi *rdf2tm-subject*)))
+			  (d:roles assoc))))
+		    (is-true object-role)
+		    (is-true subject-role)
+		    (is (eql (d:player subject-role) fifth-node))
+		    (is-false (d:psis (d:player object-role))))))))))))
+  (elephant:close-store))
+
   
+(test test-import-node-reification
+
+  )
+
 
 
 (defun run-rdf-importer-tests()
@@ -979,4 +1217,6 @@
   (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)
-  (it.bese.fiveam:run! 'test-parse-properties-of-node))
\ No newline at end of file
+  (it.bese.fiveam:run! 'test-parse-properties-of-node)
+  (it.bese.fiveam:run! 'test-import-node-1)
+  (it.bese.fiveam:run! 'test-import-node-reification))
\ 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	Mon Aug  3 13:08:11 2009
@@ -8,7 +8,7 @@
 (in-package :rdf-importer)
 
 
-(defvar *document-id* nil)
+(defvar *document-id* "isidorus-rdf-document")
 
 
 (defun setup-rdf-module (rdf-xml-path repository-path 
@@ -37,15 +37,16 @@
   "Imports the file correponding to the given path."
   (setf *document-id* document-id)
   (tm-id-p tm-id "rdf-importer")
-  (unless elephant:*store-controller*
-    (elephant:open-store
-     (get-store-spec repository-path)))
-  (let ((rdf-dom
-	 (dom:document-element (cxml:parse-file
-				(truename rdf-xml-path)
-				(cxml-dom:make-dom-builder)))))
-    (import-dom rdf-dom start-revision :tm-id tm-id :document-id document-id))
-  (setf *_n-map* nil))
+  (with-writer-lock
+    (unless elephant:*store-controller*
+      (elephant:open-store
+       (get-store-spec repository-path)))
+    (let ((rdf-dom
+	   (dom:document-element (cxml:parse-file
+				  (truename rdf-xml-path)
+				  (cxml-dom:make-dom-builder)))))
+      (import-dom rdf-dom start-revision :tm-id tm-id :document-id document-id))
+    (setf *_n-map* nil)))
 
 
 (defun init-rdf-module (&optional (revision (get-revision)))
@@ -108,61 +109,99 @@
 			    (get-literals-of-node-content elem tm-id
 							  xml-base xml-lang)))
 	  (associations (get-associations-of-node-content elem tm-id xml-base))
-	  (types (append (list
-			  (list :topicid (get-type-of-node-name elem)
-				:psi (get-type-of-node-name elem)
-				:ID nil))
-			 (get-types-of-node-content elem tm-id fn-xml-base)))
+	  (types (remove-if
+		  #'null
+		  (append (list
+			   (unless (string= (get-type-of-node-name elem)
+					    (concatenate 'string *rdf-ns*
+							 "Description"))
+			     (list :topicid (get-type-of-node-name elem)
+				   :psi (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)))
       (with-tm (start-revision document-id tm-id)
-	(let ((topic-stub
-	       (make-topic-stub
-		about ID nodeID UUID start-revision xml-importer::tm
-		:document-id document-id)))
-	  (map 'list #'(lambda(literal)
-			 (make-occurrence topic-stub literal start-revision
-					  tm-id :document-id document-id))
-	       literals)
-	  (map 'list #'(lambda(assoc)
-			 (make-association topic-stub assoc xml-importer::tm
-					   start-revision
-					   :document-id document-id))
-	       associations)
-	  (map 'list
-	       #'(lambda(type)
-		   (let ((type-topic
-			  (make-topic-stub (getf type :psi)
-					   (getf type :topicid)
-					   nil nil start-revision
-					   xml-importer::tm
-					   :document-id document-id))
-			 (ID (getf type :ID)))
-		     (make-instance-of-association topic-stub type-topic
-						   ID start-revision
-						   xml-importer::tm
-						   :document-id document-id)))
-	       types)
-	
-      ;TODO:
-      ;*import standard topics from isidorus' rdf2tm namespace
-      ;    (must be explicitly called by the user)
-      ;*get-topic by topic id
-      ;*make psis
-      ;*if the topic does not exist create one with topic id
-      ;*add psis
-      ;*make instance-of associations + reification
-      ;make super-sub-class associations + reification
-      ;*make occurrences + reification
-      ;*make associations + reification
-
-
-      ;TODO: start recursion ...
-	  (remove-node-properties-from-*_n-map* elem)
-	  (or super-classes) ;TODO: remove
-	  )))))
+	(elephant:ensure-transaction (:txn-nosync t)
+	  (let ((topic-stub
+		 (make-topic-stub
+		  about ID nodeID UUID start-revision xml-importer::tm
+		  :document-id document-id)))
+	    (map 'list #'(lambda(literal)
+			   (make-occurrence topic-stub literal start-revision
+					    tm-id :document-id document-id))
+		 literals)
+	    (map 'list #'(lambda(assoc)
+			   (make-association topic-stub assoc xml-importer::tm
+					     start-revision
+					     :document-id document-id))
+		 associations)
+	    (map 'list
+		 #'(lambda(type)
+		     (let ((type-topic
+			    (make-topic-stub (getf type :psi)
+					     nil
+					     (getf type :topicid)
+					     nil start-revision
+					     xml-importer::tm
+					     :document-id document-id))
+			   (ID (getf type :ID)))
+		       (make-instance-of-association topic-stub type-topic
+						     ID start-revision
+						     xml-importer::tm
+						     :document-id document-id)))
+		 types)
+	    (map 'list
+		 #'(lambda(class)
+		     (let ((class-topic
+			    (make-topic-stub (getf class :psi)
+					     nil
+					     (getf class :topicid)
+					     nil start-revision
+					     xml-importer::tm
+					     :document-id document-id))
+			   (ID (getf class :ID)))
+		       (make-supertype-subtype-association
+			topic-stub class-topic ID start-revision
+			xml-importer::tm :document-id document-id)))
+		 super-classes)
+	    
+	    ;TODO: start recursion ...
+	    (remove-node-properties-from-*_n-map* elem)))))))
 
 
+(defun make-supertype-subtype-association (sub-top super-top reifier-id
+					   start-revision tm
+					   &key (document-id *document-id*))
+  "Creates an supertype-subtype association."
+  (declare (TopicC sub-top super-top))
+  (declare (TopicMapC tm))
+  (let ((assoc-type (get-item-by-psi *supertype-subtype-psi*))
+	(role-type-1 (get-item-by-psi *supertype-psi*))
+	(role-type-2 (get-item-by-psi *subtype-psi*))
+	(err-pref "From make-supertype-subtype-association(): "))
+    (unless assoc-type
+      (error "~athe association type ~a is missing!"
+	     err-pref *supertype-subtype-psi*))
+    (unless (or role-type-1 role-type-2)
+      (error "~aone of the role types ~a ~a is missing!"
+	     err-pref *supertype-psi* *subtype-psi*))
+    (elephant:ensure-transaction (:txn-nosync t)
+      (let ((a-roles (list (list :instance-of role-type-1
+				 :player super-top)
+			   (list :instance-of role-type-2
+				 :player sub-top))))
+	(when reifier-id
+	  (make-reification reifier-id sub-top super-top
+			    assoc-type start-revision tm
+			    :document-id document-id))
+	(add-to-topicmap
+	 tm
+	 (make-construct 'AssociationC
+			 :start-revision start-revision
+			 :instance-of assoc-type
+			 :roles a-roles))))))
+
 
 (defun make-instance-of-association (instance-top type-top reifier-id
 				     start-revision tm
@@ -175,21 +214,29 @@
 	(roletype-1
 	 (get-item-by-psi *type-psi*))
 	(roletype-2
-	 (get-item-by-psi *instance-psi*)))
-    (let ((a-roles (list (list :instance-of roletype-1
-			       :player type-top)
-			 (list :instance-of roletype-2
-			       :player instance-top))))
-      (when reifier-id
-	(make-reification reifier-id instance-top type-top
-			  assoc-type start-revision tm
-			  :document-id document-id))
-      (add-to-topicmap
-       tm
-       (make-construct 'AssociationC
-		       :start-revision start-revision
-		       :instance-of assoc-type
-		       :roles a-roles)))))
+	 (get-item-by-psi *instance-psi*))
+	(err-pref "From make-instance-of-association(): "))
+    (unless assoc-type
+      (error "~athe association type ~a is missing!"
+	     err-pref *type-instance-psi*))
+    (unless (or roletype-1 roletype-2)
+      (error "~aone of the role types ~a ~a is missing!"
+	     err-pref *type-psi* *instance-psi*))
+    (elephant:ensure-transaction (:txn-nosync t)
+      (let ((a-roles (list (list :instance-of roletype-1
+				 :player type-top)
+			   (list :instance-of roletype-2
+				 :player instance-top))))
+	(when reifier-id
+	  (make-reification reifier-id instance-top type-top
+			    assoc-type start-revision tm
+			    :document-id document-id))
+	(add-to-topicmap
+	 tm
+	 (make-construct 'AssociationC
+			 :start-revision start-revision
+			 :instance-of assoc-type
+			 :roles a-roles))))))
 
 
 (defun make-topic-stub (about ID nodeId UUID start-revision
@@ -200,8 +247,18 @@
   (declare (TopicMapC tm))
   (let ((topic-id (or about ID nodeID UUID))
 	(psi-uri (or about ID)))
-    (let ((top (get-item-by-id topic-id :xtm-id document-id
-			       :revision start-revision)))
+    (let ((top 
+	   ;seems like there is a bug in get-item-by-id:
+	   ;this functions returns an emtpy topic although there is no one
+	   ;witha corresponding topic id and/or version and/or xtm-id
+	   (let ((inner-top
+		  (get-item-by-id topic-id :xtm-id document-id
+				  :revision start-revision)))
+	     (when (and inner-top
+			(find-if #'(lambda(x)
+				     (= (d::start-revision x) start-revision))
+				 (d::versions inner-top)))
+	       inner-top))))
       (if top
 	  top
 	  (elephant:ensure-transaction (:txn-nosync t)
@@ -245,24 +302,26 @@
 	(player-id (getf association :topicid))
 	(player-psi (getf association :psi))
 	(ID (getf association :ID)))
-    (let ((player-1 (make-topic-stub player-psi player-id nil nil start-revision
-				     tm :document-id document-id))
-	  (role-type-1 (get-item-by-psi *rdf2tm-object*))
-	  (role-type-2 (get-item-by-psi *rdf2tm-subject*))
-	  (type-top (make-topic-stub type nil nil nil start-revision
-				     tm :document-id document-id)))
-      (let ((roles (list (list :instance-of role-type-1
-			       :player player-1)
-			 (list :instance-of role-type-2
-			       :player top))))
-	(when ID
-	  (make-reification ID top type-top player-1 start-revision
-			    tm :document-id document-id))
-	(add-to-topicmap tm (make-construct 'AssociationC
-					    :start-revision start-revision
-					    :instance-of type-top
-					    :roles roles))))))
-
+    (elephant:ensure-transaction (:txn-nosync t)
+      (let ((player-1 (make-topic-stub player-psi nil player-id nil
+				       start-revision
+				       tm :document-id document-id))
+	    (role-type-1 (get-item-by-psi *rdf2tm-object*))
+	    (role-type-2 (get-item-by-psi *rdf2tm-subject*))
+	    (type-top (make-topic-stub type nil nil nil start-revision
+				       tm :document-id document-id)))
+	(let ((roles (list (list :instance-of role-type-1
+				 :player player-1)
+			   (list :instance-of role-type-2
+				 :player top))))
+	  (when ID
+	    (make-reification ID top type-top player-1 start-revision
+			      tm :document-id document-id))
+	  (add-to-topicmap tm (make-construct 'AssociationC
+					      :start-revision start-revision
+					      :instance-of type-top
+					      :roles roles)))))))
+  
 
 (defun make-association-with-nodes (subject-topic object-topic
 				    associationtype-topic tm start-revision)
@@ -275,10 +334,11 @@
 			     :player subject-topic)
 		       (list :instance-of role-type-2
 			     :player object-topic))))
-      (add-to-topicmap tm (make-construct 'AssociationC
-					  :start-revision start-revision
-					  :instance-of associationtype-topic
-					  :roles roles)))))
+      (elephant:ensure-transaction (:txn-nosync t)
+	(add-to-topicmap tm (make-construct 'AssociationC
+					    :start-revision start-revision
+					    :instance-of associationtype-topic
+					    :roles roles))))))
 
 
 (defun make-reification (reifier-id subject object predicate start-revision tm
@@ -294,25 +354,27 @@
 					tm :document-id document-id))
 	(object-arc (make-topic-stub *rdf-object* nil nil nil start-revision
 				     tm :document-id document-id))
-	(subject-arc (make-topic-stub *rdf-object* nil nil nil start-revision
+	(subject-arc (make-topic-stub *rdf-subject* nil nil nil start-revision
 				      tm :document-id document-id))
 	(statement (make-topic-stub *rdf-statement* nil nil nil start-revision
 				    tm :document-id document-id)))
-    (make-instance-of-association reifier statement nil start-revision tm
-				  :document-id document-id)
-    (make-association-with-nodes reifier subject subject-arc tm start-revision)
-    (make-association-with-nodes reifier predicate-arc predicate
-				 tm start-revision)
-    (if (typep object 'TopicC)
-	(make-association-with-nodes reifier object object-arc
-				     tm start-revision)
-	(make-construct 'OccurrenceC
-			:start-revision start-revision
-			:topic reifier
-			:themes (themes object)
-			:instance-of (instance-of object)
-			:charvalue (charvalue object)
-			:datatype (datatype object)))))
+    (elephant:ensure-transaction (:txn-nosync t)
+      (make-instance-of-association reifier statement nil start-revision tm
+				    :document-id document-id)
+      (make-association-with-nodes reifier subject subject-arc tm
+				   start-revision)
+      (make-association-with-nodes reifier predicate predicate-arc
+				   tm start-revision)
+      (if (typep object 'TopicC)
+	  (make-association-with-nodes reifier object object-arc
+				       tm start-revision)
+	  (make-construct 'OccurrenceC
+			  :start-revision start-revision
+			  :topic reifier
+			  :themes (themes object)
+			  :instance-of (instance-of object)
+			  :charvalue (charvalue object)
+			  :datatype (datatype object))))))
 
 
 (defun make-occurrence (top literal start-revision tm-id 
@@ -327,25 +389,26 @@
 	  (lang (getf literal :lang))
 	  (datatype (getf literal :datatype))
 	  (ID (getf literal :ID)))
-      (let ((type-top (make-topic-stub type nil nil nil start-revision
-				       xml-importer::tm
-				       :document-id document-id))
-	    (lang-top (make-lang-topic lang tm-id start-revision
-				       xml-importer::tm
-				       :document-id document-id)))
-	(let ((occurrence
-	       (make-construct 'OccurrenceC 
-			       :start-revision start-revision
-			       :topic top
-			       :themes (when lang-top
-					 (list lang-top))
-			       :instance-of type-top
-			       :charvalue value
-			       :datatype datatype)))
-	  (when ID
-	    (make-reification ID top type-top occurrence start-revision
-			      xml-importer::tm :document-id document-id))
-	  occurrence)))))
+      (elephant:ensure-transaction (:txn-nosync t)
+	(let ((type-top (make-topic-stub type nil nil nil start-revision
+					 xml-importer::tm
+					 :document-id document-id))
+	      (lang-top (make-lang-topic lang tm-id start-revision
+					 xml-importer::tm
+					 :document-id document-id)))
+	  (let ((occurrence
+		 (make-construct 'OccurrenceC 
+				 :start-revision start-revision
+				 :topic top
+				 :themes (when lang-top
+					   (list lang-top))
+				 :instance-of type-top
+				 :charvalue value
+				 :datatype datatype)))
+	    (when ID
+	      (make-reification ID top type-top occurrence start-revision
+				xml-importer::tm :document-id document-id))
+	    occurrence))))))
 	    
 
 (defun get-literals-of-node-content (node tm-id xml-base xml-lang)

Modified: trunk/src/xml/rdf/rdf_core_psis.xtm
==============================================================================
--- trunk/src/xml/rdf/rdf_core_psis.xtm	(original)
+++ trunk/src/xml/rdf/rdf_core_psis.xtm	Mon Aug  3 13:08:11 2009
@@ -17,11 +17,32 @@
     </name>
   </topic>
 
-    <topic id="object">
+  <topic id="object">
     <subjectIdentifier href="http://isidorus/rdf2tm_mapping#object"/>
     <name>
       <value>object</value>
     </name>
   </topic>
 
+  <topic id="supertype-subtype">
+    <subjectIdentifier href="http://psi.topicmaps.org/iso13250/model/supertype-subtype"/>
+    <name>
+      <value>supertype-subtype</value>
+    </name>
+  </topic>
+
+  <topic id="superclass">
+    <subjectIdentifier href="http://psi.topicmaps.org/iso13250/model/supertype"/>
+    <name>
+      <value>supertype</value>
+    </name>
+  </topic>
+
+  <topic id="subtype">
+    <subjectIdentifier href="http://psi.topicmaps.org/iso13250/model/subtype"/>
+    <name>
+      <value>subtype</value>
+    </name>
+  </topic>
+
 </topicMap>

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  3 13:08:11 2009
@@ -24,7 +24,10 @@
 		*rdf-subject*
 		*rdf-predicate*
 		*rdf2tm-object*
-		*rdf2tm-subject*)
+		*rdf2tm-subject*
+		*supertype-psi*
+		*subtype-psi*
+		*supertype-subtype-psi*)
   (:import-from :xml-constants
 		*rdf_core_psis.xtm*)
   (:import-from :xml-constants
@@ -59,7 +62,11 @@
 		with-writer-lock)
   (:import-from :exceptions
                 missing-reference-error
-                duplicate-identifier-error))
+                duplicate-identifier-error)
+  (:export :setup-rdf-module 
+	   :rdf-importer
+	   :init-rdf-module
+	   :*rdf-core-xtm*))
 
 (in-package :rdf-importer)
 

Modified: trunk/src/xml/xtm/tools.lisp
==============================================================================
--- trunk/src/xml/xtm/tools.lisp	(original)
+++ trunk/src/xml/xtm/tools.lisp	Mon Aug  3 13:08:11 2009
@@ -71,6 +71,8 @@
   "Returns the passed id as an absolute uri computed
    with the given base and tm-id."
   (declare (string id tm-id))
+  (when (= (length id) 0)
+    (error "From absolutize-id(): id must be set to a string with length > 0!"))
   (let ((prep-id (if (and (> (length id) 0)
 			  (eql (elt id 0) #\#))
 		     id
@@ -109,7 +111,11 @@
 		    (prep-tm-id
 		     (when (> (length tm-id) 0)
 		       (string-right-trim "/" tm-id))))
-		(concatenate 'string prep-tm-id "/" prep-fragment)))))))
+		(let ((separator
+		       (if (eql (elt prep-fragment 0) #\#)
+			   ""
+			   "/")))
+		  (concatenate 'string prep-tm-id separator prep-fragment))))))))
 
 
 (defun get-xml-lang(elem &key (old-lang nil))



From lgiessmann at common-lisp.net  Mon Aug  3 19:00:54 2009
From: lgiessmann at common-lisp.net (Lukas Giessmann)
Date: Mon, 03 Aug 2009 15:00:54 -0400
Subject: [isidorus-cvs] r104 - in trunk/src: unit_tests xml/rdf
Message-ID: <E1MY2mE-0001J8-5w@common-lisp.net>

Author: lgiessmann
Date: Mon Aug  3 15:00:53 2009
New Revision: 104

Log:
fixed a bug in the rdf-importer module which affects reification of arcs contains literal content

Modified:
   trunk/src/unit_tests/rdf_importer_test.lisp
   trunk/src/xml/rdf/importer.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  3 15:00:53 2009
@@ -1203,8 +1203,45 @@
 
   
 (test test-import-node-reification
-
-  )
+  "Tests the function import-node non-recursively. Especially the reification
+   of association- and occurrence-arcs."
+  (let ((db-dir "data_base")
+	(tm-id "http://test-tm/")
+	(revision-1 100)
+	(document-id "doc-id")
+	(doc-1
+	 (concatenate 'string "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" "
+		      "xmlns:arcs=\"http://test/arcs/\" "
+		      "xmlns:rdfs=\"" *rdfs-ns* "\">"
+		      "<rdf:Description rdf:about=\"first-node\">"
+		      "<arcs:arc1 rdf:ID=\"reification-1\">"
+		      "<rdf:Description rdf:about=\"second-node\" />"
+		      "</arcs:arc1>"
+		      "</rdf:Description>"
+		      "<rdf:Description rdf:ID=\"#reification-1\">"
+		      "<arcs:arc2 rdf:resource=\"third-node\"/>"
+		      "</rdf:Description>"
+		      "<rdf:Description rdf:nodeID=\"fourth-node\">"
+		      "<arcs:arc3 rdf:ID=\"reification-2\" rdf:datatype=\"dt\">"
+		      "occurrence data"
+		      "</arcs:arc3>"
+		      "</rdf:Description>"
+		      "<rdf:Description rdf:ID=\"#reification-2\">"
+		      "<arcs:arc4 rdf:resource=\"fifth-node\" />"
+		      "</rdf:Description>"
+		      "</rdf:RDF>")))
+    (let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder))))
+      (is-true dom-1)
+      (is (= (length (dom:child-nodes dom-1)) 1))
+      (let ((rdf-node (elt (dom:child-nodes dom-1) 0)))
+	(is (= (length (dom:child-nodes rdf-node)) 4))
+	(rdf-init-db :db-dir db-dir :start-revision revision-1)
+	(dotimes (iter (length (dom:child-nodes rdf-node)))
+	  (rdf-importer::import-node (elt (dom:child-nodes rdf-node) iter)
+				     tm-id revision-1
+				     :document-id document-id))
+     
+  ))))
 
 
 

Modified: trunk/src/xml/rdf/importer.lisp
==============================================================================
--- trunk/src/xml/rdf/importer.lisp	(original)
+++ trunk/src/xml/rdf/importer.lisp	Mon Aug  3 15:00:53 2009
@@ -315,7 +315,7 @@
 			   (list :instance-of role-type-2
 				 :player top))))
 	  (when ID
-	    (make-reification ID top type-top player-1 start-revision
+	    (make-reification ID top player-1 type-top start-revision
 			      tm :document-id document-id))
 	  (add-to-topicmap tm (make-construct 'AssociationC
 					      :start-revision start-revision
@@ -348,6 +348,7 @@
   (declare ((or OccurrenceC TopicC) object))
   (declare (TopicC subject predicate))
   (declare (TopicMapC tm))
+
   (let ((reifier (make-topic-stub reifier-id nil nil nil start-revision tm
 				  :document-id document-id))
 	(predicate-arc (make-topic-stub *rdf-predicate* nil nil nil start-revision
@@ -365,10 +366,10 @@
 				   start-revision)
       (make-association-with-nodes reifier predicate predicate-arc
 				   tm start-revision)
-      (if (typep object 'TopicC)
+      (if (typep object 'd:TopicC)
 	  (make-association-with-nodes reifier object object-arc
 				       tm start-revision)
-	  (make-construct 'OccurrenceC
+	  (make-construct 'd:OccurrenceC
 			  :start-revision start-revision
 			  :topic reifier
 			  :themes (themes object)
@@ -406,7 +407,7 @@
 				 :charvalue value
 				 :datatype datatype)))
 	    (when ID
-	      (make-reification ID top type-top occurrence start-revision
+	      (make-reification ID top occurrence type-top start-revision
 				xml-importer::tm :document-id document-id))
 	    occurrence))))))
 	    



From lgiessmann at common-lisp.net  Tue Aug  4 07:48:17 2009
From: lgiessmann at common-lisp.net (Lukas Giessmann)
Date: Tue, 04 Aug 2009 03:48:17 -0400
Subject: [isidorus-cvs] r105 - trunk/src/unit_tests
Message-ID: <E1MYEkr-0002e3-7X@common-lisp.net>

Author: lgiessmann
Date: Tue Aug  4 03:48:16 2009
New Revision: 105

Log:
added unit tests for rdf-reification; currently reification is not mapped directly into topic maps, the rdf:id attribute is mapped into special nodes with special arcs, described in rdf/xml which are mapped into topic maps

Modified:
   trunk/src/unit_tests/rdf_importer_test.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	Tue Aug  4 03:48:16 2009
@@ -31,7 +31,8 @@
 		*rdf2tm-subject*
 		*rdf-subject*
 		*rdf-object*
-		*rdf-predicate*)
+		*rdf-predicate*
+		*rdf-statement*)
   (:import-from :xml-tools
                 xpath-child-elems-by-qname
 		xpath-single-child-elem-by-qname
@@ -1240,8 +1241,196 @@
 	  (rdf-importer::import-node (elt (dom:child-nodes rdf-node) iter)
 				     tm-id revision-1
 				     :document-id document-id))
-     
-  ))))
+	(let ((reification-1 (d:get-item-by-id "http://test-tm#reification-1"
+					     :xtm-id document-id))
+	      (reification-2 (d:get-item-by-id "http://test-tm#reification-2"
+					       :xtm-id document-id))
+	      (first-node (d:get-item-by-id "http://test-tm/first-node"
+					  :xtm-id document-id))
+	      (second-node (d:get-item-by-id "http://test-tm/second-node"
+					   :xtm-id document-id))
+	      (third-node (d:get-item-by-id "http://test-tm/third-node"
+					  :xtm-id document-id))
+	      (fourth-node (d:get-item-by-id "fourth-node"
+					     :xtm-id document-id))
+	      (fifth-node (d:get-item-by-id "http://test-tm/fifth-node"
+					    :xtm-id document-id))
+	      (arc1 (d:get-item-by-id "http://test/arcs/arc1"
+				    :xtm-id document-id))
+	      (arc2 (d:get-item-by-id "http://test/arcs/arc2"
+				    :xtm-id document-id))
+	      (arc3 (d:get-item-by-id "http://test/arcs/arc3"
+				      :xtm-id document-id))
+	      (arc4 (d:get-item-by-id "http://test/arcs/arc4"
+				      :xtm-id document-id))
+	      (statement (d:get-item-by-psi *rdf-statement*))
+	      (object (d:get-item-by-psi *rdf-object*))
+	      (subject (d:get-item-by-psi *rdf-subject*))
+	      (predicate (d:get-item-by-psi *rdf-predicate*))
+	      (type (d:get-item-by-psi *type-psi*))
+	      (instance (d:get-item-by-psi *instance-psi*))
+	      (type-instance (d:get-item-by-psi *type-instance-psi*))
+	      (isi-subject (d:get-item-by-psi *rdf2tm-subject*))
+	      (isi-object (d:get-item-by-psi *rdf2tm-object*)))
+	  (is (= (length (d:psis reification-1)) 1))
+	  (is (string= (d:uri (first (d:psis reification-1)))
+		       "http://test-tm#reification-1"))
+	  (is (= (length (d:psis reification-2)) 1))
+	  (is (string= (d:uri (first (d:psis reification-2)))
+		       "http://test-tm#reification-2"))
+	  (is (= (length (d:psis first-node)) 1))
+	  (is (string= (d:uri (first (d:psis first-node)))
+		       "http://test-tm/first-node"))
+	  (is (= (length (d:psis second-node)) 1))
+	  (is (string= (d:uri (first (d:psis second-node)))
+		       "http://test-tm/second-node"))
+	  (is (= (length (d:psis third-node)) 1))
+	  (is (string= (d:uri (first (d:psis third-node)))
+		       "http://test-tm/third-node"))
+	  (is (= (length (d:psis fourth-node)) 0))
+	  (is (= (length (d:psis fifth-node)) 1))
+	  (is (string= (d:uri (first (d:psis fifth-node)))
+		       "http://test-tm/fifth-node"))
+	  (is (= (length (d:psis arc1)) 1))
+	  (is (string= (d:uri (first (d:psis arc1)))
+		       "http://test/arcs/arc1"))
+	  (is (= (length (d:psis arc2))))
+	  (is (string= (d:uri (first (d:psis arc2)))
+		       "http://test/arcs/arc2"))
+	  (is (= (length (d:psis arc3))))
+	  (is (string= (d:uri (first (d:psis arc3)))
+		       "http://test/arcs/arc3"))
+	  (is (= (length (d:psis arc4))))
+	  (is (string= (d:uri (first (d:psis arc4)))
+		       "http://test/arcs/arc4"))
+	  (is-true statement)
+	  (is-true object)
+	  (is-true subject)
+	  (is-true predicate)
+	  (is-true type)
+	  (is-true instance)
+	  (is-true type-instance)
+	  (is (= (length (d:player-in-roles first-node)) 2))
+	  (is-true (find-if #'(lambda(x)
+				(and (eql (d:instance-of x) isi-subject)
+				     (eql (d:instance-of (d:parent x)) arc1)))
+			    (d:player-in-roles first-node)))
+	  (is-true (find-if #'(lambda(x)
+				(and (eql (d:instance-of x) isi-object)
+				     (eql (d:instance-of (d:parent x))
+					  subject)))
+			    (d:player-in-roles first-node)))
+	  (is (= (length (d:player-in-roles second-node)) 2))
+	  (is-true (find-if #'(lambda(x)
+				(and (eql (d:instance-of x) isi-object)
+				     (eql (d:instance-of (d:parent x)) arc1)))
+			    (d:player-in-roles second-node)))
+	  (is-true (find-if #'(lambda(x)
+				(and (eql (d:instance-of x) isi-object)
+				     (eql (d:instance-of (d:parent x))
+					  object)))
+			    (d:player-in-roles second-node)))
+	  (is (= (length (d:player-in-roles statement)) 2))
+	  (is-true (find-if #'(lambda(x)
+				(and (eql (d:instance-of x) type)
+				     (eql (d:instance-of (d:parent x))
+					  type-instance)))
+			    (d:player-in-roles statement)))
+	  (is (= (length (d:player-in-roles arc1)) 1))
+	  (is-true (find-if #'(lambda(x)
+				(and (eql (d:instance-of x) isi-object)
+				     (eql (d:instance-of (d:parent x))
+					  predicate)))
+			    (d:player-in-roles arc1)))
+	  (is (= (length (d:player-in-roles third-node)) 1))
+	  (is-true (find-if #'(lambda(x)
+				(and (eql (d:instance-of x) isi-object)
+				     (eql (d:instance-of (d:parent x))
+					  arc2)))
+			    (d:player-in-roles third-node)))
+	  (is (= (length (d:player-in-roles reification-1)) 5))
+	  (is-true (find-if #'(lambda(x)
+				(and (eql (d:instance-of x) isi-subject)
+				     (eql (d:instance-of (d:parent x))
+					  subject)))
+			    (d:player-in-roles reification-1)))
+	  (is-true (find-if #'(lambda(x)
+				(and (eql (d:instance-of x) isi-subject)
+				     (eql (d:instance-of (d:parent x))
+					  object)))
+			    (d:player-in-roles reification-1)))
+	  (is-true (find-if #'(lambda(x)
+				(and (eql (d:instance-of x) instance)
+				     (eql (d:instance-of (d:parent x))
+					  type-instance)))
+			    (d:player-in-roles reification-1)))
+	  (is-true (find-if #'(lambda(x)
+				(and (eql (d:instance-of x) isi-subject)
+				     (eql (d:instance-of (d:parent x))
+					  object)))
+			    (d:player-in-roles reification-1)))
+	  (is-true (find-if #'(lambda(x)
+				(and (eql (d:instance-of x) isi-subject)
+				     (eql (d:instance-of (d:parent x))
+					  predicate)))
+			    (d:player-in-roles reification-1)))
+	  (is-true (find-if #'(lambda(x)
+				(and (eql (d:instance-of x) isi-subject)
+				     (eql (d:instance-of (d:parent x))
+					  arc2)))
+			    (d:player-in-roles reification-1)))
+	  (is (= (length (d:occurrences fourth-node)) 1))
+	  (is (string= (d:charvalue (first (d:occurrences fourth-node)))
+		       "occurrence data"))
+	  (is (string= (d:datatype (first (d:occurrences fourth-node)))
+		       "http://test-tm/dt"))
+	  (is (eql (d:instance-of (first (d:occurrences fourth-node)))
+		   arc3))
+	  (is (= (length (d:player-in-roles fourth-node)) 1))
+	  (is-true (find-if #'(lambda(x)
+				(and (eql (d:instance-of x) isi-object)
+				     (eql (d:instance-of (d:parent x))
+					  subject)))
+			    (d:player-in-roles fourth-node)))
+	  (is (= (length (d:player-in-roles arc3)) 1))
+	  (is-true (find-if #'(lambda(x)
+				(and (eql (d:instance-of x) isi-object)
+				     (eql (d:instance-of (d:parent x))
+					  predicate)))
+			    (d:player-in-roles arc3)))
+	  (is (= (length (d:player-in-roles fifth-node)) 1))
+	  (is-true (find-if #'(lambda(x)
+				(and (eql (d:instance-of x) isi-object)
+				     (eql (d:instance-of (d:parent x))
+					  arc4)))
+			    (d:player-in-roles fifth-node)))
+	  (is (= (length (d:occurrences reification-2)) 1))
+	  (is (string= (d:charvalue (first (d:occurrences reification-2)))
+		       "occurrence data"))
+	  (is (string= (d:datatype (first (d:occurrences reification-2)))
+		       "http://test-tm/dt"))
+	  (is (= (length (d:player-in-roles reification-2)) 4))
+	  (is-true (find-if #'(lambda(x)
+				(and (eql (d:instance-of x) isi-subject)
+				     (eql (d:instance-of (d:parent x))
+					  subject)))
+			    (d:player-in-roles reification-2)))
+	  (is-true (find-if #'(lambda(x)
+				(and (eql (d:instance-of x) isi-subject)
+				     (eql (d:instance-of (d:parent x))
+					  predicate)))
+			    (d:player-in-roles reification-2)))
+	  (is-true (find-if #'(lambda(x)
+				(and (eql (d:instance-of x) isi-subject)
+				     (eql (d:instance-of (d:parent x))
+					  arc4)))
+			    (d:player-in-roles reification-2)))
+	  (is-true (find-if #'(lambda(x)
+				(and (eql (d:instance-of x) instance)
+				     (eql (d:instance-of (d:parent x))
+					  type-instance)))
+			    (d:player-in-roles reification-2)))
+	  (elephant:close-store))))))
 
 
 



From lgiessmann at common-lisp.net  Wed Aug  5 10:53:46 2009
From: lgiessmann at common-lisp.net (Lukas Giessmann)
Date: Wed, 05 Aug 2009 06:53:46 -0400
Subject: [isidorus-cvs] r106 - in trunk/src: . unit_tests xml/rdf
Message-ID: <E1MYe7u-0005Af-5c@common-lisp.net>

Author: lgiessmann
Date: Wed Aug  5 06:53:45 2009
New Revision: 106

Log:
added a function that from import-node furhter function to import the entire dom recursively

Modified:
   trunk/src/constants.lisp
   trunk/src/unit_tests/poems.rdf
   trunk/src/unit_tests/rdf_importer_test.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	Wed Aug  5 06:53:45 2009
@@ -32,8 +32,12 @@
 	   :*rdf-object*
 	   :*rdf-subject*
 	   :*rdf-predicate*
+	   :*rdf-nil*
+	   :*rdf-first*
+	   :*rdf-rest*
 	   :*rdf2tm-object*
-	   :*rdf2tm-subject*))
+	   :*rdf2tm-subject*
+	   :*rdf2tm-collection*))
 
 (in-package :constants)
 (defparameter *xtm2.0-ns* "http://www.topicmaps.org/xtm/")
@@ -80,6 +84,14 @@
 
 (defparameter *rdf-predicate* "http://www.w3.org/1999/02/22-rdf-syntax-ns#predicate")
 
+(defparameter *rdf-nil* "http://www.w3.org/1999/02/22-rdf-syntax-ns#nil")
+
+(defparameter *rdf-first* "http://www.w3.org/1999/02/22-rdf-syntax-ns#first")
+
+(defparameter *rdf-rest* "http://www.w3.org/1999/02/22-rdf-syntax-ns#rest")
+
 (defparameter *rdf2tm-object* "http://isidorus/rdf2tm_mapping#object")
 
-(defparameter *rdf2tm-subject* "http://isidorus/rdf2tm_mapping#subject")
\ No newline at end of file
+(defparameter *rdf2tm-subject* "http://isidorus/rdf2tm_mapping#subject")
+
+(defparameter *rdf2tm-collection* "http://isidorus/rdf2tm_mapping#collection")
\ No newline at end of file

Modified: trunk/src/unit_tests/poems.rdf
==============================================================================
--- trunk/src/unit_tests/poems.rdf	(original)
+++ trunk/src/unit_tests/poems.rdf	Wed Aug  5 06:53:45 2009
@@ -3165,10 +3165,10 @@
 	  <types:Ballad>
 	    <arcs:title rdf:parseType="Literal">Die zwei Gesellen</arcs:title>
 	    <arcs:title rdf:parseType="Literal">Fr?hlingsfahrt</arcs:title>
-	    <arcs:daterange rdf:parseType="Resource">
+	    <arcs:dateRange rdf:parseType="Resource">
 	      <arcs:start rdf:datatype="http://www.w3.org/2001/XMLSchema#date">01.01.1818</arcs:start>
 	      <arcs:end rdf:datatype="http://www.w3.org/2001/XMLSchema#date">31.12.1818</arcs:end>
-	    </arcs:daterange>
+	    </arcs:dateRange>
 	    <arcs:content rdf:parseType="Literal" xml:lang="de">
 	      <![CDATA[Es zogen zwei r?st?ge Gesellen
 Zum erstenmal von Haus,

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	Wed Aug  5 06:53:45 2009
@@ -51,7 +51,8 @@
 	   :test-get-associations-of-node-content
 	   :test-parse-properties-of-node
 	   :test-import-node-1
-	   :test-import-node-reification))
+	   :test-import-node-reification
+	   :test-import-dom))
 
 (declaim (optimize (debug 3) (speed 0) (safety 3) (space 0) (compilation-speed 0)))
 
@@ -1433,6 +1434,46 @@
 	  (elephant:close-store))))))
 
 
+(test test-import-dom
+  "Tests the function import-node when used recursively."
+  (let ((db-dir "data_base")
+	(tm-id "http://test-tm/")
+	(revision-1 100)
+	(document-id "doc-id")
+	(doc-1
+	 (concatenate 'string "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" "
+		      "xmlns:arcs=\"http://test/arcs/\" "
+		      "xmlns:rdfs=\"" *rdfs-ns* "\">"
+		      "<rdf:Description1 rdf:about=\"first-node\">"
+		      "<rdf:type rdf:nodeID=\"second-node\"/>"
+		      "<arcs:arc1 rdf:resource=\"third-node\"/>"
+		      "<arcs:arc2 rdf:datatype=\"long\">123</arcs:arc2>"
+		      "<arcs:arc3>"
+		      "<rdf:Description3>"
+		      "<arcs:arc4 rdf:parseType=\"Collection\">"
+		      "<rdf:Description4 rdf:about=\"item-1\"/>"
+		      "<rdf:Description5 rdf:about=\"item-2\">"
+		      "<arcs:arc5 rdf:parseType=\"Resource\">"
+		      "<arcs:arc7 rdf:resource=\"fourth-node\"/>"
+		      "<arcs:arc8 rdf:parseType=\"Collection\" />"
+		      "</arcs:arc5>"
+		      "</rdf:Description5>"
+		      "</arcs:arc4>"
+		      "</rdf:Description3>"
+		      "</arcs:arc3>"
+		      "</rdf:Description1>"
+		      "<rdf:Description2 rdf:nodeID=\"second-node\" />"
+		      "</rdf:RDF>")))
+	(let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder))))
+	  (is-true dom-1)
+	  (is (= (length (dom:child-nodes dom-1)) 1))
+	  (rdf-init-db :db-dir db-dir :start-revision revision-1)
+	  (let ((rdf-node (elt (dom:child-nodes dom-1) 0)))
+	    (is (= (length (dom:child-nodes rdf-node)) 2))
+	    (rdf-importer::import-dom rdf-node revision-1 :tm-id tm-id
+				      :document-id document-id)))))
+
+
 
 (defun run-rdf-importer-tests()
   (it.bese.fiveam:run! 'test-get-literals-of-node)
@@ -1445,4 +1486,5 @@
   (it.bese.fiveam:run! 'test-get-associations-of-node-content)
   (it.bese.fiveam:run! 'test-parse-properties-of-node)
   (it.bese.fiveam:run! 'test-import-node-1)
-  (it.bese.fiveam:run! 'test-import-node-reification))
\ No newline at end of file
+  (it.bese.fiveam:run! 'test-import-node-reification)
+  (it.bese.fiveam:run! 'test-import-dom))
\ 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	Wed Aug  5 06:53:45 2009
@@ -78,6 +78,7 @@
 (defun import-dom (rdf-dom start-revision
 		   &key (tm-id nil) (document-id *document-id*))
   "Imports the entire dom of a rdf-xml-file."
+  (setf *_n-map* nil) ;in case of an failed last call
   (tm-id-p tm-id "import-dom")
   (let ((xml-base (get-xml-base rdf-dom))
 	(xml-lang (get-xml-lang rdf-dom))
@@ -85,29 +86,33 @@
 	(elem-ns (dom:namespace-uri rdf-dom)))
     (if (and (string= elem-ns *rdf-ns*)
 	     (string= elem-name "RDF"))
-	(let ((children (child-nodes-or-text rdf-dom)))
+	(let ((children (child-nodes-or-text rdf-dom :trim t)))
 	  (when children
 	    (loop for child across children
 	       do (import-node child tm-id start-revision :document-id document-id
 			       :xml-base xml-base :xml-lang xml-lang))))
 	(import-node rdf-dom tm-id start-revision :document-id document-id
-		     :xml-base xml-base :xml-lang xml-lang))))
+		     :xml-base xml-base :xml-lang xml-lang)))
+  (setf *_n-map* nil))
 
 
 (defun import-node (elem tm-id start-revision &key (document-id *document-id*)
 		    (xml-base nil) (xml-lang nil))
-  (remove-node-properties-from-*_n-map* elem) ;in case of an failed last call
+  (format t ">> import-node: ~a <<~%" (dom:node-name elem))
   (tm-id-p tm-id "import-node")
   (parse-node elem)
-  (let ((fn-xml-base (get-xml-base elem :old-base xml-base)))
+  ;TODO: handle Collections that are made manually without
+  ;      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 xml-lang)
-			    (get-literals-of-node-content elem tm-id
-							  xml-base xml-lang)))
+	  (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))
 	  (types (remove-if
 		  #'null
@@ -123,51 +128,164 @@
 	   (get-super-classes-of-node-content elem tm-id xml-base)))
       (with-tm (start-revision document-id tm-id)
 	(elephant:ensure-transaction (:txn-nosync t)
-	  (let ((topic-stub
+	  (let ((this
 		 (make-topic-stub
 		  about ID nodeID UUID start-revision xml-importer::tm
 		  :document-id document-id)))
-	    (map 'list #'(lambda(literal)
-			   (make-occurrence topic-stub literal start-revision
-					    tm-id :document-id document-id))
-		 literals)
-	    (map 'list #'(lambda(assoc)
-			   (make-association topic-stub assoc xml-importer::tm
-					     start-revision
-					     :document-id document-id))
-		 associations)
-	    (map 'list
-		 #'(lambda(type)
-		     (let ((type-topic
-			    (make-topic-stub (getf type :psi)
-					     nil
-					     (getf type :topicid)
-					     nil start-revision
-					     xml-importer::tm
-					     :document-id document-id))
-			   (ID (getf type :ID)))
-		       (make-instance-of-association topic-stub type-topic
-						     ID start-revision
-						     xml-importer::tm
-						     :document-id document-id)))
-		 types)
-	    (map 'list
-		 #'(lambda(class)
-		     (let ((class-topic
-			    (make-topic-stub (getf class :psi)
-					     nil
-					     (getf class :topicid)
-					     nil start-revision
-					     xml-importer::tm
-					     :document-id document-id))
-			   (ID (getf class :ID)))
-		       (make-supertype-subtype-association
-			topic-stub class-topic ID start-revision
-			xml-importer::tm :document-id document-id)))
-		 super-classes)
-	    
-	    ;TODO: start recursion ...
-	    (remove-node-properties-from-*_n-map* elem)))))))
+	    (make-literals this literals tm-id start-revision
+			   :document-id document-id)
+	    (make-associations this associations xml-importer::tm
+			       start-revision :document-id document-id)
+	    (make-types this types xml-importer::tm start-revision
+			:document-id document-id)
+	    (make-super-classes this super-classes xml-importer::tm
+				start-revision :document-id document-id)
+	    (make-recursion-from-node elem tm-id start-revision
+				      :document-id document-id
+				      :xml-base xml-base
+				      :xml-lang xml-lang)
+	    (remove-node-properties-from-*_n-map* elem)
+	    this))))))
+
+
+(defun import-arc (elem tm-id start-revision
+		   &key (document-id *document-id*)
+		   (xml-base nil) (xml-lang nil))
+  "Imports a property that is an blank_node and continues the recursion
+   on this element."
+  (declare (dom:element elem))
+  (format t ">> import-arc: ~a <<~%" (dom:node-name elem))
+  (let ((fn-xml-lang (get-xml-lang elem :old-lang xml-lang))
+	(fn-xml-base (get-xml-base elem :old-base xml-base))
+	(UUID (get-ns-attribute elem "UUID" :ns-uri *rdf2tm-ns*))
+	(parseType (get-ns-attribute elem "parseType")))
+    (when (or (not parseType)
+	      (and parseType
+		   (string/= parseType "Collection")))
+      (when UUID
+	(parse-properties-of-node elem)
+	(with-tm (start-revision document-id tm-id)
+	  (let ((this (get-item-by-id UUID :xtm-id document-id
+				      :revision start-revision)))
+	    (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))
+		  (types (get-types-of-node-content elem tm-id fn-xml-base))
+		  (super-classes
+		   (get-super-classes-of-node-content elem tm-id xml-base)))
+	      (make-literals this literals tm-id start-revision
+			     :document-id document-id)
+	      (make-associations this associations xml-importer::tm
+				 start-revision :document-id document-id)
+	      (make-types this types xml-importer::tm start-revision
+			  :document-id document-id)
+	      (make-super-classes this super-classes xml-importer::tm
+				  start-revision :document-id document-id))))))
+    (make-recursion-from-arc elem tm-id start-revision
+			     :document-id document-id
+			     :xml-base xml-base :xml-lang xml-lang)))
+
+
+(defun make-collection (elem owner-top tm-id start-revision
+			&key (document-id *document-id*)
+			(xml-base nil) (xml-lang nil))
+  "Creates a TM association with a subject role containing the collection
+   entry point and as many roles of the type 'object' as items exists."
+  (declare (d:TopicC owner-top))
+  (with-tm (start-revision document-id tm-id)
+    (let ((fn-xml-base (get-xml-base elem :old-base xml-base))
+	  (fn-xml-lang (get-xml-lang elem :old-lang xml-lang))
+	  (subject (make-topic-stub *rdf2tm-subject* nil nil nil start-revision
+				    xml-importer::tm :document-id document-id))
+	  (object (make-topic-stub *rdf2tm-object* nil nil nil start-revision
+				   xml-importer::tm :document-id document-id)))
+      (let ((association-type (make-topic-stub *rdf2tm-collection* nil nil nil
+					       start-revision xml-importer::tm
+					       :document-id document-id))
+	    (roles
+	     (append
+	      (loop for item across (child-nodes-or-text elem :trim t)
+		 collect (let ((item-top (import-node item tm-id start-revision
+						      :document-id document-id
+						      :xml-base fn-xml-base
+						      :xml-lang fn-xml-lang)))
+			   (list :player item-top
+				 :instance-of object)))
+	      (list (list :player owner-top
+			  :instance-of subject)))))
+	(add-to-topicmap
+	 xml-importer::tm
+	 (make-construct 'd:AssociationC
+			 :start-revision start-revision
+			 :instance-of association-type
+			 :roles roles))))))
+
+
+(defun make-literals (owner-top literals tm-id start-revision
+		      &key (document-id *document-id*))
+  "Creates Topic Maps constructs (occurrences) of the passed 
+   named list literals related to the topic owner-top."
+  (declare (d:TopicC owner-top))
+  (map 'list #'(lambda(literal)
+		 (make-occurrence owner-top literal start-revision
+				  tm-id :document-id document-id))
+       literals))
+
+
+(defun make-associations (owner-top associations tm start-revision
+			  &key (document-id *document-id*))
+  "Creates Topic Maps constructs (assocaitions) of the passed 
+   named list literals related to the topic owner-top."
+  (declare (d:TopicC owner-top))
+  (map 'list #'(lambda(assoc)
+		 (make-association owner-top assoc tm
+				   start-revision
+				   :document-id document-id))
+       associations))
+
+
+(defun make-types (owner-top types tm start-revision
+		   &key (document-id *document-id*))
+  "Creates instance-of associations corresponding to the passed
+   topic owner-top and the passed types."
+  (declare (d:TopicC owner-top))
+  (map 'list
+       #'(lambda(type)
+	   (let ((type-topic
+		  (make-topic-stub (getf type :psi)
+				   nil
+				   (getf type :topicid)
+				   nil start-revision tm
+				   :document-id document-id))
+		 (ID (getf type :ID)))
+	     (make-instance-of-association owner-top type-topic
+					   ID start-revision tm
+					   :document-id document-id)))
+       types))
+
+
+(defun make-super-classes (owner-top super-classes tm start-revision
+			   &key (document-id *document-id*))
+  "Creates supertype-subtype associations corresponding to the passed
+   topic owner-top and the passed super classes."
+  (declare (d:TopicC owner-top))
+  (map 'list
+       #'(lambda(class)
+	   (let ((class-topic
+		  (make-topic-stub (getf class :psi)
+				   nil
+				   (getf class :topicid)
+				   nil start-revision tm
+				   :document-id document-id))
+		 (ID (getf class :ID)))
+	     (make-supertype-subtype-association
+	      owner-top class-topic ID start-revision tm
+	      :document-id document-id)))
+       super-classes))
+
+
 
 
 (defun make-supertype-subtype-association (sub-top super-top reifier-id
@@ -176,9 +294,15 @@
   "Creates an supertype-subtype association."
   (declare (TopicC sub-top super-top))
   (declare (TopicMapC tm))
-  (let ((assoc-type (get-item-by-psi *supertype-subtype-psi*))
-	(role-type-1 (get-item-by-psi *supertype-psi*))
-	(role-type-2 (get-item-by-psi *subtype-psi*))
+  (let ((assoc-type
+	 (make-topic-stub *supertype-subtype-psi* nil nil nil
+			  start-revision tm :document-id document-id))
+	(role-type-1
+	 (make-topic-stub *supertype-psi* nil nil nil
+			  start-revision tm :document-id document-id))
+	(role-type-2
+	 (make-topic-stub *subtype-psi* nil nil nil
+			  start-revision tm :document-id document-id))
 	(err-pref "From make-supertype-subtype-association(): "))
     (unless assoc-type
       (error "~athe association type ~a is missing!"
@@ -210,11 +334,14 @@
   (declare (TopicC type-top instance-top))
   (declare (TopicMapC tm))
   (let ((assoc-type
-	 (get-item-by-psi *type-instance-psi*))
+	 (make-topic-stub *type-instance-psi* nil nil nil
+			  start-revision tm :document-id document-id))
 	(roletype-1
-	 (get-item-by-psi *type-psi*))
+	 (make-topic-stub *type-psi* nil nil nil
+			  start-revision tm :document-id document-id))
 	(roletype-2
-	 (get-item-by-psi *instance-psi*))
+	 (make-topic-stub *instance-psi* nil nil nil
+			  start-revision tm :document-id document-id))
 	(err-pref "From make-instance-of-association(): "))
     (unless assoc-type
       (error "~athe association type ~a is missing!"
@@ -266,13 +393,15 @@
 			 (make-instance 'PersistentIdC
 					:uri psi-uri
 					:start-revision start-revision))))
-	      (add-to-topicmap
-	       tm
-	       (make-construct 'TopicC
-			       :topicid topic-id
-			       :psis (when psi (list psi))
-			       :xtm-id document-id
-			       :start-revision start-revision))))))))
+	      (handler-case (add-to-topicmap
+			     tm
+			     (make-construct 'TopicC
+					     :topicid topic-id
+					     :psis (when psi (list psi))
+					     :xtm-id document-id
+					     :start-revision start-revision))
+		(Condition (err)(error "Creating topic ~a failed: ~a"
+				       topic-id err)))))))))
 
 
 (defun make-lang-topic (lang tm-id start-revision tm
@@ -306,8 +435,12 @@
       (let ((player-1 (make-topic-stub player-psi nil player-id nil
 				       start-revision
 				       tm :document-id document-id))
-	    (role-type-1 (get-item-by-psi *rdf2tm-object*))
-	    (role-type-2 (get-item-by-psi *rdf2tm-subject*))
+	    (role-type-1
+	     (make-topic-stub *rdf2tm-object* nil nil nil
+			      start-revision tm :document-id document-id))
+	    (role-type-2
+	     (make-topic-stub *rdf2tm-subject* nil nil nil
+			      start-revision tm :document-id document-id))
 	    (type-top (make-topic-stub type nil nil nil start-revision
 				       tm :document-id document-id)))
 	(let ((roles (list (list :instance-of role-type-1
@@ -324,12 +457,17 @@
   
 
 (defun make-association-with-nodes (subject-topic object-topic
-				    associationtype-topic tm start-revision)
+				    associationtype-topic tm start-revision
+				    &key (document-id *document-id*))
   "Creates an association with two roles that contains the given players."
   (declare (TopicC subject-topic object-topic associationtype-topic))
   (declare (TopicMapC tm))
-  (let ((role-type-1 (get-item-by-psi *rdf2tm-subject*))
-	(role-type-2 (get-item-by-psi *rdf2tm-object*)))
+  (let ((role-type-1
+	 (make-topic-stub *rdf2tm-subject* nil nil nil start-revision
+			  tm :document-id document-id))
+	(role-type-2
+	 (make-topic-stub *rdf2tm-object* nil nil nil start-revision
+			  tm :document-id document-id)))
     (let ((roles (list (list :instance-of role-type-1
 			     :player subject-topic)
 		       (list :instance-of role-type-2
@@ -363,12 +501,13 @@
       (make-instance-of-association reifier statement nil start-revision tm
 				    :document-id document-id)
       (make-association-with-nodes reifier subject subject-arc tm
-				   start-revision)
+				   start-revision :document-id document-id)
       (make-association-with-nodes reifier predicate predicate-arc
-				   tm start-revision)
+				   tm start-revision :document-id document-id)
       (if (typep object 'd:TopicC)
 	  (make-association-with-nodes reifier object object-arc
-				       tm start-revision)
+				       tm start-revision
+				       :document-id document-id)
 	  (make-construct 'd:OccurrenceC
 			  :start-revision start-revision
 			  :topic reifier
@@ -416,7 +555,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-content")
-  (let ((properties (child-nodes-or-text node))
+  (let ((properties (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
@@ -486,8 +625,8 @@
 		      :ID nil))
 	       nil))
 	  (content-types
-	   (when (child-nodes-or-text node)
-	     (loop for child across (child-nodes-or-text node)
+	   (when (child-nodes-or-text node :trim t)
+	     (loop for child across (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"))
@@ -505,7 +644,7 @@
 				     (get-xml-base child :old-base fn-xml-base)))
 				(let ((refs
 				       (get-node-refs
-					(child-nodes-or-text child)
+					(child-nodes-or-text child :trim t)
 					tm-id child-xml-base)))
 				  (list :topicid (getf (first refs) :topicid)
 					:psi (getf (first refs) :psi)
@@ -601,7 +740,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))
+  (let ((content (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
@@ -624,7 +763,7 @@
 			       :psi resource
 			       :ID ID)
 			 (let ((refs (get-node-refs
-				      (child-nodes-or-text property)
+				      (child-nodes-or-text property :trim t)
 				      tm-id prop-xml-base)))
 			   (list :topicid (getf (first refs) :topicid)
 				 :psi (getf (first refs) :psi)
@@ -634,7 +773,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))
+  (let ((properties (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))
@@ -675,9 +814,68 @@
 			     :psi resource
 			     :ID ID)
 		       (let ((refs (get-node-refs
-				    (child-nodes-or-text property)
+				    (child-nodes-or-text property :trim t)
 				    tm-id prop-xml-base)))
 			 (list :type full-name
 			       :topicid (getf (first refs) :topicid)
 			       :psi (getf (first refs) :psi)
-			       :ID ID))))))))
\ No newline at end of file
+			       :ID ID))))))))
+
+
+(defun make-recursion-from-node (node tm-id start-revision
+				 &key (document-id *document-id*)
+				 (xml-base nil) (xml-lang nil))
+  "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))
+	(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)))
+    (when (stringp content)
+      (error "~aliteral content not allowed here: ~a"
+	     err-pref content))
+    (loop for arc across content
+       do (import-arc arc tm-id start-revision :document-id document-id
+		      :xml-base fn-xml-base :xml-lang fn-xml-lang))))
+
+
+(defun make-recursion-from-arc (arc tm-id start-revision
+				&key (document-id *document-id*)
+				(xml-base nil) (xml-lang nil))
+  "Calls the next function that handles the arcs content nodes/arcs."
+  (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))
+	(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"))
+	  (resource (get-absolute-attribute arc tm-id xml-base "resource"))
+	  (nodeID (get-ns-attribute arc "nodeID"))
+	  (literals (get-literals-of-property arc xml-lang)))
+      (if (and parseType
+	       (string= parseType "Collection"))
+	  (loop for item across content
+	     do (import-node item tm-id start-revision :document-id document-id
+			     :xml-base fn-xml-base :xml-lang fn-xml-lang))
+	  (if (or datatype resource nodeID
+		  (and parseType
+		       (string= parseType "Literal"))
+		  (and content
+		       (stringp content)))
+	      t;; do nothing current elem is a literal node that has been
+	       ;; already imported as an occurrence
+	      (if (or type literals
+		      (and parseType
+			   (string= parseType "Resource")))
+		  (loop for item across content
+		     do (import-arc item tm-id start-revision
+				    :document-id document-id
+				    :xml-base fn-xml-base
+				    :xml-lang fn-xml-lang))
+		  (loop for item across content
+		     do (import-node item tm-id start-revision
+				     :document-id document-id
+				     :xml-base xml-base
+				     :xml-lang xml-lang))))))))

Modified: trunk/src/xml/rdf/rdf_tools.lisp
==============================================================================
--- trunk/src/xml/rdf/rdf_tools.lisp	(original)
+++ trunk/src/xml/rdf/rdf_tools.lisp	Wed Aug  5 06:53:45 2009
@@ -27,7 +27,11 @@
 		*rdf2tm-subject*
 		*supertype-psi*
 		*subtype-psi*
-		*supertype-subtype-psi*)
+		*supertype-subtype-psi*
+		*rdf-nil*
+		*rdf-first*
+		*rdf-rest*
+		*rdf2tm-collection*)
   (:import-from :xml-constants
 		*rdf_core_psis.xtm*)
   (:import-from :xml-constants
@@ -132,7 +136,7 @@
 (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)))
+  (let ((properties (child-nodes-or-text node :trim t)))
     (when properties
       (loop for property across properties
 	 do (unset-_n-name property))))
@@ -203,7 +207,7 @@
 	       (or about nodeID))
       (error "~awhen rdf:ID is set the attributes rdf:~a is not allowed: ~a!"
 	     err-pref (if about "about" "nodeID") (or about nodeID)))
-    (unless (or ID nodeID about)
+    (unless (or ID nodeID about (dom:has-attribute-ns node *rdf2tm-ns* "UUID"))
       (dom:set-attribute-ns node *rdf2tm-ns* "UUID" (get-uuid)))
     (handler-case (let ((content (child-nodes-or-text node :trim t)))
 		    (when (stringp content)
@@ -320,7 +324,8 @@
     (when (and parseType
 	       (or (string= parseType "Resource")
 		   (string= parseType "Collection")))
-      (dom:set-attribute-ns property *rdf2tm-ns* "UUID" (get-uuid)))
+      (unless (dom:has-attribute-ns property *rdf2tm-ns* "UUID")
+	(dom:set-attribute-ns property *rdf2tm-ns* "UUID" (get-uuid))))
     (when (and parseType (string= parseType "Resource") (stringp content))
       (error "~ardf:parseType is set to 'Resource' expecting xml content: ~a!"
 	     err-pref content))
@@ -356,7 +361,8 @@
 		   (> (length literals) 0))
 	       (not (or nodeID resource))
 	       (not content))
-      (dom:set-attribute-ns property *rdf2tm-ns* "UUID" (get-uuid)))
+      (unless (dom:has-attribute-ns property *rdf2tm-ns* "UUID")
+	(dom:set-attribute-ns property *rdf2tm-ns* "UUID" (get-uuid))))
     (when (or about subClassOf)
       (error "~a~a not allowed here!"
 	     err-pref
@@ -366,7 +372,8 @@
     (when (and (string= node-name "subClassOf")
 	       (string= node-ns *rdfs-ns*)
 	       (not (or nodeID resource content)))
-      (dom:set-attribute-ns property *rdf2tm-ns* "UUID" (get-uuid)))
+      (unless (dom:has-attribute-ns property *rdf2tm-ns* "UUID")
+	(dom:set-attribute-ns property *rdf2tm-ns* "UUID" (get-uuid))))
     (when (and (or (and (string= node-name "type")
 			(string= node-ns *rdf-ns*))
 		   (and (string= node-name "subClassOf")
@@ -393,7 +400,7 @@
   "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))
+  (let ((child-nodes (child-nodes-or-text node :trim t))
 	(_n-counter 0))
     (when (get-ns-attribute node "li")
       (dom:map-node-map
@@ -436,5 +443,4 @@
 	   (get-absolute-attribute elem tm-id fn-xml-base "datatype")))
       (if datatype
 	  datatype
-	  *xml-string*))))
-				 
\ No newline at end of file
+	  *xml-string*))))
\ No newline at end of file



From lgiessmann at common-lisp.net  Wed Aug  5 11:58:19 2009
From: lgiessmann at common-lisp.net (Lukas Giessmann)
Date: Wed, 05 Aug 2009 07:58:19 -0400
Subject: [isidorus-cvs] r107 - in trunk/src: unit_tests xml/rdf
Message-ID: <E1MYf8N-0000xa-Jn@common-lisp.net>

Author: lgiessmann
Date: Wed Aug  5 07:58:19 2009
New Revision: 107

Log:
fixed a bug in the rdf-importer which occurs when the rdf-file contains a collection

Modified:
   trunk/src/unit_tests/rdf_importer_test.lisp
   trunk/src/xml/rdf/importer.lisp
   trunk/src/xml/rdf/rdf_core_psis.xtm
   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	Wed Aug  5 07:58:19 2009
@@ -1038,7 +1038,7 @@
 	  (rdf-init-db :db-dir db-dir :start-revision revision-1)
 	  (rdf-importer::import-node node tm-id revision-2
 				     :document-id document-id)
-	  (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 20))
+	  (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 21))
 	  (let ((first-node (get-item-by-id "http://test-tm/first-node"
 					    :xtm-id document-id))
 		(first-type (get-item-by-id "http://test-tm/first-type"
@@ -1442,27 +1442,29 @@
 	(document-id "doc-id")
 	(doc-1
 	 (concatenate 'string "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" "
-		      "xmlns:arcs=\"http://test/arcs/\" "
-		      "xmlns:rdfs=\"" *rdfs-ns* "\">"
-		      "<rdf:Description1 rdf:about=\"first-node\">"
+		      "xmlns:arcs=\"http://test/arcs/\">"
+		      "<rdf:Description rdf:about=\"first-node\">"
 		      "<rdf:type rdf:nodeID=\"second-node\"/>"
 		      "<arcs:arc1 rdf:resource=\"third-node\"/>"
 		      "<arcs:arc2 rdf:datatype=\"long\">123</arcs:arc2>"
 		      "<arcs:arc3>"
-		      "<rdf:Description3>"
+		      "<rdf:Description>"
 		      "<arcs:arc4 rdf:parseType=\"Collection\">"
-		      "<rdf:Description4 rdf:about=\"item-1\"/>"
-		      "<rdf:Description5 rdf:about=\"item-2\">"
+		      "<rdf:Description rdf:about=\"item-1\"/>"
+		      "<rdf:Description rdf:about=\"item-2\">"
 		      "<arcs:arc5 rdf:parseType=\"Resource\">"
-		      "<arcs:arc7 rdf:resource=\"fourth-node\"/>"
+		      "<arcs:arc6 rdf:resource=\"fourth-node\"/>"
+		      "<arcs:arc7>"
+		      "<rdf:Description rdf:about=\"fifth-node\"/>"
+		      "</arcs:arc7>"
 		      "<arcs:arc8 rdf:parseType=\"Collection\" />"
 		      "</arcs:arc5>"
-		      "</rdf:Description5>"
+		      "</rdf:Description>"
 		      "</arcs:arc4>"
-		      "</rdf:Description3>"
+		      "</rdf:Description>"
 		      "</arcs:arc3>"
-		      "</rdf:Description1>"
-		      "<rdf:Description2 rdf:nodeID=\"second-node\" />"
+		      "</rdf:Description>"
+		      "<rdf:Description rdf:nodeID=\"second-node\" />"
 		      "</rdf:RDF>")))
 	(let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder))))
 	  (is-true dom-1)

Modified: trunk/src/xml/rdf/importer.lisp
==============================================================================
--- trunk/src/xml/rdf/importer.lisp	(original)
+++ trunk/src/xml/rdf/importer.lisp	Wed Aug  5 07:58:19 2009
@@ -98,7 +98,7 @@
 
 (defun import-node (elem tm-id start-revision &key (document-id *document-id*)
 		    (xml-base nil) (xml-lang nil))
-  (format t ">> import-node: ~a <<~%" (dom:node-name elem))
+  (format t ">> import-node: ~a <<~%" (dom:node-name elem)) ;TODO: remove
   (tm-id-p tm-id "import-node")
   (parse-node elem)
   ;TODO: handle Collections that are made manually without
@@ -154,7 +154,7 @@
   "Imports a property that is an blank_node and continues the recursion
    on this element."
   (declare (dom:element elem))
-  (format t ">> import-arc: ~a <<~%" (dom:node-name elem))
+  (format t ">> import-arc: ~a <<~%" (dom:node-name elem)) ;TODO: remove
   (let ((fn-xml-lang (get-xml-lang elem :old-lang xml-lang))
 	(fn-xml-base (get-xml-base elem :old-base xml-base))
 	(UUID (get-ns-attribute elem "UUID" :ns-uri *rdf2tm-ns*))
@@ -848,7 +848,8 @@
   (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))
-	(parseType (get-ns-attribute arc "parseType")))
+	(parseType (get-ns-attribute arc "parseType"))
+	(UUID (get-ns-attribute arc "UUID" :ns-uri *rdf2tm-ns*)))
     (let ((datatype (get-absolute-attribute arc tm-id xml-base "datatype"))
 	  (type (get-absolute-attribute arc tm-id xml-base "type"))
 	  (resource (get-absolute-attribute arc tm-id xml-base "resource"))
@@ -856,9 +857,15 @@
 	  (literals (get-literals-of-property arc xml-lang)))
       (if (and parseType
 	       (string= parseType "Collection"))
-	  (loop for item across content
-	     do (import-node item tm-id start-revision :document-id document-id
-			     :xml-base fn-xml-base :xml-lang fn-xml-lang))
+	  (let ((this
+		 (with-tm (start-revision document-id tm-id)
+		   (make-topic-stub nil nil nil UUID start-revision
+				    xml-importer::tm
+				    :document-id document-id))))
+	    (make-collection arc this tm-id start-revision
+			     :document-id document-id
+			     :xml-base xml-base
+			     :xml-lang xml-lang))
 	  (if (or datatype resource nodeID
 		  (and parseType
 		       (string= parseType "Literal"))

Modified: trunk/src/xml/rdf/rdf_core_psis.xtm
==============================================================================
--- trunk/src/xml/rdf/rdf_core_psis.xtm	(original)
+++ trunk/src/xml/rdf/rdf_core_psis.xtm	Wed Aug  5 07:58:19 2009
@@ -23,6 +23,13 @@
       <value>object</value>
     </name>
   </topic>
+  
+  <topic id="collection">
+    <subjectIdentifier href="http://isidorus/rdf2tm_mapping#collection"/>
+    <name>
+      <value>object</value>
+    </name>
+  </topic>
 
   <topic id="supertype-subtype">
     <subjectIdentifier href="http://psi.topicmaps.org/iso13250/model/supertype-subtype"/>

Modified: trunk/src/xml/rdf/rdf_tools.lisp
==============================================================================
--- trunk/src/xml/rdf/rdf_tools.lisp	(original)
+++ trunk/src/xml/rdf/rdf_tools.lisp	Wed Aug  5 07:58:19 2009
@@ -214,7 +214,7 @@
 		      (error "text-content not allowed here!")))
       (condition (err) (error "~a~a" err-pref err)))
     (when (or resource datatype parseType class subClassOf)
-      (error "~a~a is not allowed here!"
+      (error "~a~a is not allowed here (~a)!"
 	     err-pref (cond
 			(resource (concatenate 'string "resource("
 					       resource ")"))
@@ -224,7 +224,8 @@
 						parseType ")"))
 			(class (concatenate 'string "Class(" class ")"))
 			(subClassOf (concatenate 'string "subClassOf("
-						 subClassOf ")")))))
+						 subClassOf ")")))
+	     (dom:node-name node)))
     (dolist (item *rdf-types*)
       (when (get-ns-attribute node item)
 	(error "~ardf:~a is a type and not allowed here!"



From lgiessmann at common-lisp.net  Wed Aug  5 15:45:12 2009
From: lgiessmann at common-lisp.net (Lukas Giessmann)
Date: Wed, 05 Aug 2009 11:45:12 -0400
Subject: [isidorus-cvs] r108 - in trunk/src: unit_tests xml/rdf
Message-ID: <E1MYifw-0003II-T8@common-lisp.net>

Author: lgiessmann
Date: Wed Aug  5 11:45:12 2009
New Revision: 108

Log:
rdf-importer: added some unit tests

Modified:
   trunk/src/unit_tests/rdf_importer_test.lisp
   trunk/src/xml/rdf/importer.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	Wed Aug  5 11:45:12 2009
@@ -1443,37 +1443,288 @@
 	(doc-1
 	 (concatenate 'string "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" "
 		      "xmlns:arcs=\"http://test/arcs/\">"
-		      "<rdf:Description rdf:about=\"first-node\">"
-		      "<rdf:type rdf:nodeID=\"second-node\"/>"
-		      "<arcs:arc1 rdf:resource=\"third-node\"/>"
-		      "<arcs:arc2 rdf:datatype=\"long\">123</arcs:arc2>"
-		      "<arcs:arc3>"
-		      "<rdf:Description>"
-		      "<arcs:arc4 rdf:parseType=\"Collection\">"
-		      "<rdf:Description rdf:about=\"item-1\"/>"
-		      "<rdf:Description rdf:about=\"item-2\">"
-		      "<arcs:arc5 rdf:parseType=\"Resource\">"
-		      "<arcs:arc6 rdf:resource=\"fourth-node\"/>"
-		      "<arcs:arc7>"
-		      "<rdf:Description rdf:about=\"fifth-node\"/>"
-		      "</arcs:arc7>"
-		      "<arcs:arc8 rdf:parseType=\"Collection\" />"
-		      "</arcs:arc5>"
-		      "</rdf:Description>"
-		      "</arcs:arc4>"
-		      "</rdf:Description>"
-		      "</arcs:arc3>"
-		      "</rdf:Description>"
-		      "<rdf:Description rdf:nodeID=\"second-node\" />"
+		      " <rdf:Description rdf:about=\"first-node\">"
+		      "  <rdf:type rdf:nodeID=\"second-node\"/>"
+		      "  <arcs:arc1 rdf:resource=\"third-node\"/>"
+		      "  <arcs:arc2 rdf:datatype=\"long\">123</arcs:arc2>"
+		      "  <arcs:arc3>"
+		      "   <rdf:Description>"
+		      "    <arcs:arc4 rdf:parseType=\"Collection\">"
+		      "     <rdf:Description rdf:about=\"item-1\"/>"
+		      "     <rdf:Description rdf:about=\"item-2\">"
+		      "      <arcs:arc5 rdf:parseType=\"Resource\">"
+		      "       <arcs:arc6 rdf:resource=\"fourth-node\"/>"
+		      "       <arcs:arc7>"
+		      "        <rdf:Description rdf:about=\"fifth-node\"/>"
+		      "       </arcs:arc7>"
+		      "       <arcs:arc8 rdf:parseType=\"Collection\" />"
+		      "      </arcs:arc5>"
+		      "     </rdf:Description>"
+		      "    </arcs:arc4>"
+		      "   </rdf:Description>"
+		      "  </arcs:arc3>"
+		      " </rdf:Description>"
+		      " <rdf:Description rdf:nodeID=\"second-node\" />"
 		      "</rdf:RDF>")))
 	(let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder))))
 	  (is-true dom-1)
 	  (is (= (length (dom:child-nodes dom-1)) 1))
 	  (rdf-init-db :db-dir db-dir :start-revision revision-1)
 	  (let ((rdf-node (elt (dom:child-nodes dom-1) 0)))
-	    (is (= (length (dom:child-nodes rdf-node)) 2))
+	    (is (= (length (rdf-importer::child-nodes-or-text  rdf-node
+							       :trim t))
+		   2))
 	    (rdf-importer::import-dom rdf-node revision-1 :tm-id tm-id
-				      :document-id document-id)))))
+				      :document-id document-id)
+	    (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 38))
+	    (is (= (length (elephant:get-instances-by-class 'd:AssociationC)) 10))
+	    (setf rdf-importer::*current-xtm* document-id)
+	    (is (= (length
+		    (intersection
+		     (map 'list #'d:instance-of
+			  (elephant:get-instances-by-class 'd:AssociationC))
+		     (list
+		      (d:get-item-by-id (concatenate
+					 'string
+					 constants::*rdf2tm-collection*)
+					:xtm-id rdf-importer::*rdf-core-xtm*)
+		      (d:get-item-by-psi constants::*type-instance-psi*)
+		      (dotimes (iter 9)
+			(let ((pos (+ iter 1))
+			      (topics nil))
+			  (when (/= pos 2)
+			    (push (get-item-by-id
+				   (concatenate
+				    'string "http://test/arcs/arc"
+				    (write-to-string pos))) topics))
+			  topics)))))))
+	    (let ((first-node (get-item-by-id "http://test-tm/first-node"))
+		  (second-node (get-item-by-id "second-node"))
+		  (third-node (get-item-by-id "http://test-tm/third-node"))
+		  (fourth-node (get-item-by-id "http://test-tm/fourth-node"))
+		  (fifth-node (get-item-by-id "http://test-tm/fifth-node"))
+		  (item-1 (get-item-by-id "http://test-tm/item-1"))
+		  (item-2 (get-item-by-id "http://test-tm/item-2"))
+		  (arc1 (get-item-by-id "http://test/arcs/arc1"))
+		  (arc2 (get-item-by-id "http://test/arcs/arc2"))
+		  (arc3 (get-item-by-id "http://test/arcs/arc3"))
+		  (arc4 (get-item-by-id "http://test/arcs/arc4"))
+		  (arc5 (get-item-by-id "http://test/arcs/arc5"))
+		  (arc6 (get-item-by-id "http://test/arcs/arc6"))
+		  (arc7 (get-item-by-id "http://test/arcs/arc7"))
+		  (arc8 (get-item-by-id "http://test/arcs/arc8"))
+		  (instance (d:get-item-by-psi constants::*instance-psi*))
+		  (type (d:get-item-by-psi constants::*type-psi*))
+		  (type-instance (d:get-item-by-psi
+				  constants:*type-instance-psi*))
+		  (subject (d:get-item-by-psi constants::*rdf2tm-subject*))
+		  (object (d:get-item-by-psi constants::*rdf2tm-object*))
+		  (collection (d:get-item-by-id
+			       constants::*rdf2tm-collection*)))
+	      (is (= (length (d:psis first-node)) 1))
+	      (is (string= (d:uri (first (d:psis first-node)))
+			   "http://test-tm/first-node"))
+	      (is (= (length (d:psis second-node)) 0))
+	      (is (= (length (d:psis third-node)) 1))
+	      (is (string= (d:uri (first (d:psis third-node)))
+			   "http://test-tm/third-node"))
+	      (is (= (length (d:psis fourth-node)) 1))
+	      (is (string= (d:uri (first (d:psis fourth-node)))
+			   "http://test-tm/fourth-node"))
+	      (is (= (length (d:psis fifth-node)) 1))
+	      (is (string= (d:uri (first (d:psis fifth-node)))
+			   "http://test-tm/fifth-node"))
+	      (is (= (length (d:psis item-1)) 1))
+	      (is (string= (d:uri (first (d:psis item-1)))
+			   "http://test-tm/item-1"))
+	      (is (= (length (d:psis item-2)) 1))
+	      (is (string= (d:uri (first (d:psis item-2)))
+			   "http://test-tm/item-2"))
+	      (is (= (length (d:psis arc1)) 1))
+	      (is (string= (d:uri (first (d:psis arc1)))
+			   "http://test/arcs/arc1"))
+	      (is (= (length (d:psis arc2)) 1))
+	      (is (string= (d:uri (first (d:psis arc2)))
+			   "http://test/arcs/arc2"))
+	      (is (= (length (d:psis arc3)) 1))
+	      (is (string= (d:uri (first (d:psis arc3)))
+			   "http://test/arcs/arc3"))
+	      (is (= (length (d:psis arc4)) 1))
+	      (is (string= (d:uri (first (d:psis arc4)))
+			   "http://test/arcs/arc4"))
+	      (is (= (length (d:psis arc5)) 1))
+	      (is (string= (d:uri (first (d:psis arc5)))
+			   "http://test/arcs/arc5"))
+	      (is (= (length (d:psis arc6)) 1))
+	      (is (string= (d:uri (first (d:psis arc6)))
+			   "http://test/arcs/arc6"))
+	      (is (= (length (d:psis arc7)) 1))
+	      (is (string= (d:uri (first (d:psis arc7)))
+			   "http://test/arcs/arc7"))
+	      (is (= (length (d:psis arc8)) 1))
+	      (is (string= (d:uri (first (d:psis arc8)))
+			   "http://test/arcs/arc8"))
+	      (is (= (length (elephant:get-instances-by-class 'd:OccurrenceC))
+		     1))
+	      (is (string= (d:charvalue (first (elephant:get-instances-by-class
+						'd:OccurrenceC)))
+			   "123"))
+	      (is (string= (d:datatype (first (elephant:get-instances-by-class
+					       'd:OccurrenceC)))
+			   "http://test-tm/long"))
+	      (is (= (length (d:occurrences first-node)) 1))
+	      (is (= (length (d:player-in-roles first-node)) 3))
+	      (is (= (count-if
+		      #'(lambda(x)
+			  (or (and (eql (d:instance-of x) instance)
+				   (eql (d:instance-of (d:parent x))
+					type-instance))
+			      (and (eql (d:instance-of x) subject)
+				   (eql (d:instance-of (d:parent x)) arc1))
+			      (and (eql (d:instance-of x) subject)
+				   (eql (d:instance-of (d:parent x)) arc3))))
+		      (d:player-in-roles first-node))
+		     3))
+	      (is (= (length (d:player-in-roles second-node)) 1))
+	      (is-true (find-if
+			#'(lambda(x)
+			    (and (eql (d:instance-of x) type)
+				 (eql (d:instance-of (d:parent x))
+				      type-instance)))
+			(d:player-in-roles second-node)))
+	      (is (= (length (d:player-in-roles third-node)) 1))
+	      (is-true (find-if
+			#'(lambda(x)
+			    (and (eql (d:instance-of x) object)
+				 (eql (d:instance-of (d:parent x))
+				      arc1)))
+			(d:player-in-roles third-node)))
+	      (let ((uuid-1
+		     (d:player
+		      (find-if
+		       #'(lambda(y)
+			   (and (eql (d:instance-of y) object)
+				(= 0 (length (d:psis (d:player y))))))
+		       (d:roles
+			(d:parent
+			 (find-if
+			  #'(lambda(x)
+			      (and (eql (d:instance-of x) subject)
+				   (eql (d:instance-of (d:parent x)) arc3)))
+			  (d:player-in-roles first-node))))))))
+		(is-true uuid-1)
+		(is (= (length (d:player-in-roles uuid-1)) 2))
+		(is-true (find-if
+			  #'(lambda(x)
+			      (and (eql (d:instance-of x) subject)
+				   (eql (d:instance-of (d:parent x)) arc4)))
+			  (d:player-in-roles uuid-1)))
+		(let ((col-1
+		       (d:player
+			(find-if
+			 #'(lambda(y)
+			     (and (eql (d:instance-of y) object)
+				  (= 0 (length (d:psis (d:player y))))))
+			 (d:roles
+			  (d:parent
+			   (find-if
+			    #'(lambda(x)
+				(and (eql (d:instance-of x) subject)
+				     (eql (d:instance-of (d:parent x)) arc4)))
+			    (d:player-in-roles uuid-1))))))))
+		  (is-true col-1)
+		  (is (= (length (d:player-in-roles col-1)) 2))
+		  (is-true (find-if
+			    #'(lambda(x)
+				(and (eql (d:instance-of x) subject)
+				     (eql (d:instance-of (d:parent x)) 
+					  collection)))
+			    (d:player-in-roles col-1)))
+		  (let ((col-assoc
+			 (d:parent
+			  (find-if
+			    #'(lambda(x)
+				(and (eql (d:instance-of x) subject)
+				     (eql (d:instance-of (d:parent x)) 
+					  collection)))
+			    (d:player-in-roles col-1)))))
+		    (is-true col-assoc)
+		    (is (= (length (d:roles col-assoc)) 3))
+		    (is (= (count-if
+			    #'(lambda(x)
+				(and (eql (d:instance-of x) object)
+				     (or (eql (d:player x) item-1)
+					 (eql (d:player x) item-2))))
+			    (d:roles col-assoc))
+			   2))))
+		(is (= (length (d:player-in-roles item-1)) 1))
+		(is (= (length (d:player-in-roles item-2)) 2))
+		(is-true (find-if
+			  #'(lambda(x)
+			      (and (eql (d:instance-of x) subject)
+				   (eql (d:instance-of (d:parent x)) arc5)))
+			  (d:player-in-roles item-2)))
+		(let ((uuid-2
+		       (d:player
+			(find-if
+			 #'(lambda(y)
+			     (and (eql (d:instance-of y) object)
+				  (= 0 (length (d:psis (d:player y))))))
+			 (d:roles
+			  (d:parent
+			   (find-if
+			    #'(lambda(x)
+				(and (eql (d:instance-of x) subject)
+				     (eql (d:instance-of (d:parent x)) arc5)))
+			    (d:player-in-roles item-2))))))))
+		  (is-true uuid-2)
+		  (is (= (length (d:player-in-roles uuid-2)) 4))
+		  (is (= (count-if
+			  #'(lambda(x)
+			      (or (and (eql (d:instance-of x) object)
+				       (eql (d:instance-of (d:parent x)) arc5))
+				  (and (eql (d:instance-of x) subject)
+				       (or
+					(eql (d:instance-of (d:parent x)) arc6)
+					(eql (d:instance-of (d:parent x)) arc7)
+					(eql (d:instance-of
+					      (d:parent x)) arc8)))))
+			  (d:player-in-roles uuid-2))
+			 4))
+		  (is (= (length (d:player-in-roles fourth-node)) 1))
+		  (is (= (length (d:player-in-roles fifth-node)) 1))
+		  (let ((col-2
+			 (d:player
+			  (find-if
+			   #'(lambda(y)
+			       (and (eql (d:instance-of y) object)
+				    (= 0 (length (d:psis (d:player y))))))
+			   (d:roles
+			    (d:parent
+			     (find-if
+			      #'(lambda(x)
+				  (and (eql (d:instance-of x) subject)
+				       (eql (d:instance-of (d:parent x)) arc8)))
+			      (d:player-in-roles uuid-2))))))))
+		    (is-true col-2)
+		    (is (= (length (d:player-in-roles col-2)) 2))
+		    (is-true (find-if
+			      #'(lambda(x)
+				  (and (eql (d:instance-of x) subject)
+				       (eql (d:instance-of (d:parent x)) 
+					    collection)))
+			      (d:player-in-roles col-2)))
+		    (let ((col-assoc
+			   (d:parent
+			    (find-if
+			     #'(lambda(x)
+				 (and (eql (d:instance-of x) subject)
+				      (eql (d:instance-of (d:parent x)) 
+					   collection)))
+			     (d:player-in-roles col-2)))))
+		      (is-true col-assoc)
+		      (is (= (length (d:roles col-assoc)) 1))))))))))
+  (elephant:close-store))
 
 
 

Modified: trunk/src/xml/rdf/importer.lisp
==============================================================================
--- trunk/src/xml/rdf/importer.lisp	(original)
+++ trunk/src/xml/rdf/importer.lisp	Wed Aug  5 11:45:12 2009
@@ -167,12 +167,19 @@
 	(with-tm (start-revision document-id tm-id)
 	  (let ((this (get-item-by-id UUID :xtm-id document-id
 				      :revision start-revision)))
-	    (let ((literals (append (get-literals-of-node elem fn-xml-lang)
+	    (let ((literals (append (get-literals-of-property 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))
-		  (types (get-types-of-node-content elem tm-id fn-xml-base))
+		  (types (remove-if
+			  #'null
+			  (append
+			   (get-types-of-node-content elem tm-id fn-xml-base)
+			   (when (get-ns-attribute elem "type")
+			     (list :ID nil
+				   :topicid (get-ns-attribute elem "type")
+				   :psi (get-ns-attribute elem "type"))))))
 		  (super-classes
 		   (get-super-classes-of-node-content elem tm-id xml-base)))
 	      (make-literals this literals tm-id start-revision
@@ -286,8 +293,6 @@
        super-classes))
 
 
-
-
 (defun make-supertype-subtype-association (sub-top super-top reifier-id
 					   start-revision tm
 					   &key (document-id *document-id*))



From lgiessmann at common-lisp.net  Thu Aug  6 15:46:12 2009
From: lgiessmann at common-lisp.net (Lukas Giessmann)
Date: Thu, 06 Aug 2009 11:46:12 -0400
Subject: [isidorus-cvs] r109 - in trunk/src: . unit_tests xml/rdf
Message-ID: <E1MZ5AS-0003Fz-FA@common-lisp.net>

Author: lgiessmann
Date: Thu Aug  6 11:46:11 2009
New Revision: 109

Log:
changed some rdf test files

Added:
   trunk/src/unit_tests/poems_light.rdf
Modified:
   trunk/src/isidorus.asd
   trunk/src/unit_tests/fixtures.lisp
   trunk/src/unit_tests/poems.rdf
   trunk/src/unit_tests/rdf_importer_test.lisp
   trunk/src/unit_tests/unittests-constants.lisp
   trunk/src/xml/rdf/rdf_tools.lisp

Modified: trunk/src/isidorus.asd
==============================================================================
--- trunk/src/isidorus.asd	(original)
+++ trunk/src/isidorus.asd	Thu Aug  6 11:46:11 2009
@@ -106,6 +106,7 @@
 				     (:static-file "atom_test.xtm")
 				     (:static-file "poems.xtm")
 				     (:static-file "poems.rdf")
+				     (:static-file "poems_light.rdf")
 				     (:file "atom-conf")
 				     (:file "unittests-constants"
 					    :depends-on ("dangling_topicref.xtm"

Modified: trunk/src/unit_tests/fixtures.lisp
==============================================================================
--- trunk/src/unit_tests/fixtures.lisp	(original)
+++ trunk/src/unit_tests/fixtures.lisp	Thu Aug  6 11:46:11 2009
@@ -35,7 +35,9 @@
 	   :*NOTIFICATIONBASE-TM*
 	   :*XTM-TM*
            :*XTM-MERGE1-TM*
-           :*XTM-MERGE2-TM*))
+           :*XTM-MERGE2-TM*
+	   :rdf-init-db
+	   :rdf-test-db))
 
 (in-package :fixtures)
 
@@ -166,4 +168,26 @@
     (importer *XTM-ATOM-TM* :xtm-id "atom-tm1" :tm-id "http://psi.egovpt.org/tm/egov-ontology"
               :revision revision1)
     (&body) 
+    (tear-down-test-db)))
+
+
+(defun rdf-init-db (&key (db-dir "data_base") (start-revision (get-revision)))
+  "Deletes the data base files and initializes isidorus for rdf."
+  (when elephant:*store-controller*
+    (elephant:close-store))
+  (clean-out-db db-dir)
+  (elephant:open-store (xml-importer:get-store-spec db-dir))
+  (xml-importer:init-isidorus start-revision)
+  (rdf-importer:init-rdf-module start-revision))
+
+
+(def-fixture rdf-test-db ()
+  (let ((db-dir "data_base")
+	(tm-id "http://test-tm/")
+	(document-id "doc-id"))
+    (clean-out-db db-dir)
+    (rdf-importer:setup-rdf-module *poems_light.rdf* db-dir :tm-id tm-id
+				   :document-id document-id)
+    (elephant:open-store (xml-importer:get-store-spec db-dir))
+    (&body)
     (tear-down-test-db)))
\ No newline at end of file

Modified: trunk/src/unit_tests/poems.rdf
==============================================================================
--- trunk/src/unit_tests/poems.rdf	(original)
+++ trunk/src/unit_tests/poems.rdf	Thu Aug  6 11:46:11 2009
@@ -55,6 +55,7 @@
 	<arcs:date rdf:datatype="#date" xml:base="http://www.w3.org/2001/XMLSchema">22.03.1832</arcs:date>
 	<arcs:place xml:base="">
 	  <types:City rdf:about="Weimar" arcs:fullName="Weimar">
+	    <rdfs:subClassOf rdf:resource="http://some.where/types/Region"/>
 	    <arcs:population rdf:datatype="http://www.w3.org/2001/XMLSchema#unsigneLong">64720</arcs:population>
 	    <arcs:locatedIn rdf:resource="http://some.where/country/Germany"/>
 	  </types:City>
@@ -66,7 +67,7 @@
     <arcs:wrote>
       <rdf:Bag rdf:nodeID="goethe_literature">
 	<rdf:li>
-	  <types:Poem>
+	  <types:Poem rdf:about="http://some.where/poem/Der_Zauberlehrling">
 	    <arcs:title rdf:parseType="Literal" xml:lang="de">Der Zauberlehrling</arcs:title>
 	    <arcs:dateRange rdf:parseType="Resource" xml:base="http://www.w3.org/2001/XMLSchema"> <!-- rdf:parseType="resource" == bland_node --> 
 	      <arcs:start rdf:datatype="#date">01.01.1797</arcs:start>
@@ -194,10 +195,10 @@
   <!-- referenced ressources by goethe -->
   <rdf:Description rdf:nodeID="goethe_literature">
     <rdf:li>
-      <types:Ballad arcs:title="Der Erlk?nig" xml:lang="de">
+      <types:Ballad rdf:about="http://some.where/ballad/Der_Erlkoenig" arcs:title="Der Erlk?nig" xml:lang="de">
 	<arcs:dateRange rdf:parseType="Resource" xml:base="http://www.w3.org/2001/XMLSchema">
 	  <arcs:start rdf:datatype="#date">01.01.1782</arcs:start>
-	  <arcs:end  rdf:datatype="#date">01.01.1782</arcs:end>
+	  <arcs:end  rdf:datatype="#date">31.12.1782</arcs:end>
 	</arcs:dateRange>
 	<arcs:content rdf:datatype="http://www.w3.org/2001/XMLSchema#string" xml:lang="de">
 	  <![CDATA[Wer reitet so sp?t durch Nacht und Wind?
@@ -243,7 +244,7 @@
       </types:Ballad>
     </rdf:li>
     <rdf:li>
-      <rdf:Description arcs:title="Prometheus">
+      <rdf:Description rdf:about="http://some.where/poem/Prometheus" arcs:title="Prometheus">
 	<rdf:type rdf:resource="/types/Poem"/>
 	<arcs:dateRange>
 	  <rdf:Description xml:base="http://does.not.exist">
@@ -354,7 +355,7 @@
       <rdf:Description>
 	<rdf:type rdf:resource="http://www.w3.org/1999/02/22-rdf-syntax-ns#Bag"/>
 	<rdf:_1>
-	  <types:Poem arcs:title="Resigantion" xml:lang="de">
+	  <types:Poem rdf:about="http://some.where/poem/Resignation" arcs:title="Resigantion" xml:lang="de">
 	    <arcs:dateRange rdf:parseType="Resource">
 	      <arcs:start rdf:datatype="http://www.w3.org/2001/XMLSchema#date">01.01.1786</arcs:start>
 	      <arcs:end rdf:datatype="http://www.w3.org/2001/XMLSchema#date">31.12.1786</arcs:end>
@@ -471,7 +472,7 @@
 	  </types:Poem>
 	</rdf:_1>
 	<rdf:_2>
-	  <types:Drama arcs:title="Die R?uber" xml:lang="de">
+	  <types:Drama rdf:about="http://some.where/drama/Die_Raeuber" arcs:title="Die R?uber" xml:lang="de">
 	    <arcs:dateRange>
 	      <rdf:Description>
 		<arcs:start rdf:datatype="http://www.w3.org/2001/XMLSchema#date">01.01.1781</arcs:start>
@@ -3138,7 +3139,7 @@
     <arcs:wrote>
       <rdf:Bag>
 	<rdf:li>
-	  <types:Poem arcs:title="Mondnacht">
+	  <types:Poem rdf:about="http://some.where/poem/Mondnacht" arcs:title="Mondnacht">
 	    <arcs:dateRange rdf:parseType="Resource">
 	      <arcs:start rdf:datatype="http://www.w3.org/2001/XMLSchema#date">01.01.1837</arcs:start>
 	      <arcs:end rdf:datatype="http://www.w3.org/2001/XMLSchema#date">31.12.1837</arcs:end>
@@ -3162,7 +3163,7 @@
 	  </types:Poem>
 	</rdf:li>
 	<rdf:li>
-	  <types:Ballad>
+	  <types:Ballad rdf:about="http://some.where/ballad/Die_zwei_Gesellen">
 	    <arcs:title rdf:parseType="Literal">Die zwei Gesellen</arcs:title>
 	    <arcs:title rdf:parseType="Literal">Fr?hlingsfahrt</arcs:title>
 	    <arcs:dateRange rdf:parseType="Resource">
@@ -3256,7 +3257,7 @@
     <arcs:wrote>
       <rdf:Bag>
 	<rdf:_1>
-	  <types:Poem arcs:title="Venus And Adonis">
+	  <types:Poem rdf:about="http://some.where/poem/Venus_And_Adonis" arcs:title="Venus And Adonis">
 	    <arcs:dateRange rdf:parseType="Resource">
 	      <arcs:start rdf:datatype="http://www.w3.org/2001/XMLSchema#date">01.01.1592</arcs:start>
 	      <arcs:end rdf:datatype="http://www.w3.org/2001/XMLSchema#date">31.12.1593</arcs:end>
@@ -4677,7 +4678,7 @@
 	  </types:Poem>
 	</rdf:_1>
 	<rdf:_2>
-	  <types:Drama arcs:title="Venus And Adonis">
+	  <types:Drama rdf:about="http://some.where/drama/Romeo_And_Juliet" arcs:title="Romeo and Juliet">
 	    <arcs:dateRange rdf:parseType="Resource">
 	      <arcs:start rdf:datatype="http://www.w3.org/2001/XMLSchema#date">01.01.1597</arcs:start>
 	      <arcs:end rdf:datatype="http://www.w3.org/2001/XMLSchema#date">31.12.1597</arcs:end>

Added: trunk/src/unit_tests/poems_light.rdf
==============================================================================
--- (empty file)
+++ trunk/src/unit_tests/poems_light.rdf	Thu Aug  6 11:46:11 2009
@@ -0,0 +1,328 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<rdf:RDF xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
+	 xmlns:rdfs="http://www.w3.org/2000/01/rdf-schema#"
+	 xmlns:poems="http://some.where/"
+	 xmlns:arcs="http://some.where/relationship/"
+	 xmlns:types="http://some.where/types/"
+	 xml:base="http://some.where/">
+  <!-- === Goethe ========================================================== -->
+  <rdf:Description rdf:about="author/Goethe">
+    <rdf:type rdf:resource="types/Author"/>
+    <arcs:firstName>Johann Wolfgang</arcs:firstName>
+    <arcs:lastName rdf:parseType="Literal">von Goethe</arcs:lastName>
+
+    <!-- === born event ==================================================== -->
+    <arcs:born>
+      <types:Event>
+	<arcs:date rdf:datatype="http://www.w3.org/2001/XMLSchema#date">28.08.1749</arcs:date>
+	<arcs:place>
+	  <rdf:Description rdf:about="/region/FrankfurtMain">
+	    <rdf:type>
+	      <rdf:Description rdf:about="/types/Metropolis">
+		<rdfs:subClassOf rdf:resource="/types/Region"/>
+	      </rdf:Description>
+	    </rdf:type>
+	    <arcs:fullName>Frankfurt am Main</arcs:fullName>
+	    <arcs:population rdf:datatype="http://www.w3.org/2001/XMLSchema#unsignedLong">659000</arcs:population>
+	    <arcs:locatedIn>
+	      <rdf:Description rdf:about="http://some.where/country/Germany">
+		<rdf:type>
+		  <rdf:Description rdf:about="http://some.where/types/Country"></rdf:Description>
+		</rdf:type>
+		<arcs:nativeName xml:lang="de">Deutschland</arcs:nativeName>
+		<arcs:population rdf:datatype="http://www.w3.org/2001/XMLSchema#unsignedLong">82099232</arcs:population>
+		<arcs:officialese rdf:resource="language/German"/>
+		<arcs:capital>
+		  <rdf:Description rdf:about="http://some.where/region/Berlin">
+		    <rdf:type>
+		      <rdf:Description rdf:about="http://some.where/types/Metropolis"/>
+		    </rdf:type>
+		    <arcs:locatedIn rdf:resource="/country/Germany"/>
+		    <arcs:population rdf:datatype="http://www.w3.org/2001/XMLSchema#unsignedLong">3431473</arcs:population>
+		  </rdf:Description>
+		</arcs:capital>
+	      </rdf:Description>
+	    </arcs:locatedIn>
+	  </rdf:Description>
+	</arcs:place>
+      </types:Event>
+    </arcs:born>
+
+    <!-- === died event ==================================================== -->
+    <arcs:died>
+      <rdf:Description xml:base="http://some.where/types/">
+	<rdf:type rdf:resource="Event"/>
+	<arcs:date rdf:datatype="#date" xml:base="http://www.w3.org/2001/XMLSchema">22.03.1832</arcs:date>
+	<arcs:place xml:base="">
+	  <types:City rdf:about="Weimar" arcs:fullName="Weimar">
+	    <rdfs:subClassOf rdf:resource="http://some.where/types/Region"/>
+	    <arcs:population rdf:datatype="http://www.w3.org/2001/XMLSchema#unsigneLong">64720</arcs:population>
+	    <arcs:locatedIn rdf:resource="http://some.where/country/Germany"/>
+	  </types:City>
+	</arcs:place>
+      </rdf:Description>
+    </arcs:died>
+
+    <!-- === wrote bag ===================================================== -->
+    <arcs:wrote>
+      <rdf:Bag rdf:nodeID="goethe_literature">
+	<rdf:li>
+	  <types:Poem rdf:about="http://some.where/poem/Der_Zauberlehrling">
+	    <arcs:title rdf:parseType="Literal" xml:lang="de">Der Zauberlehrling</arcs:title>
+	    <arcs:dateRange rdf:parseType="Resource" xml:base="http://www.w3.org/2001/XMLSchema"> <!-- rdf:parseType="resource" == bland_node --> 
+	      <arcs:start rdf:datatype="#date">01.01.1797</arcs:start>
+	      <arcs:end rdf:datatype="#date">31.12.1797</arcs:end>
+	    </arcs:dateRange>
+	    <arcs:content xml:lang="de">
+	      <![CDATA[Hat der alte Hexenmeister
+sich doch einmal wegbegeben!
+Und nun sollen seine Geister
+auch nach meinem Willen leben.
+Seine Wort und Werke
+merkt ich und den Brauch,
+und mit Geistesst?rke
+tu ich Wunder auch.
+
+Walle! walle
+Manche Strecke,
+da?, zum Zwecke,
+Wasser flie?e
+und mit reichem, vollem Schwalle
+zu dem Bade sich ergie?e.
+
+Und nun komm, du alter Besen!
+Nimm die schlechten Lumpenh?llen;
+bist schon lange Knecht gewesen:
+nun erf?lle meinen Willen!
+Auf zwei Beinen stehe,
+oben sei ein Kopf,
+eile nun und gehe
+mit dem Wassertopf!
+
+Walle! walle
+manche Strecke,
+da?, zum Zwecke,
+Wasser flie?e
+und mit reichem, vollem Schwalle
+zu dem Bade sich ergie?e.
+
+Seht, er l?uft zum Ufer nieder,
+Wahrlich! ist schon an dem Flusse,
+und mit Blitzesschnelle wieder
+ist er hier mit raschem Gusse.
+Schon zum zweiten Male!
+Wie das Becken schwillt!
+Wie sich jede Schale
+voll mit Wasser f?llt!
+
+Stehe! stehe!
+denn wir haben
+deiner Gaben
+vollgemessen! -
+Ach, ich merk es! Wehe! wehe!
+Hab ich doch das Wort vergessen!
+
+Ach, das Wort, worauf am Ende
+er das wird, was er gewesen.
+Ach, er l?uft und bringt behende!
+W?rst du doch der alte Besen!
+Immer neue G?sse
+bringt er schnell herein,
+Ach! und hundert Fl?sse
+st?rzen auf mich ein.
+
+Nein, nicht l?nger
+kann ichs lassen;
+will ihn fassen.
+Das ist T?cke!
+Ach! nun wird mir immer b?nger!
+Welche Mine! welche Blicke!
+
+O du Ausgeburt der H?lle!
+Soll das ganze Haus ersaufen?
+Seh ich ?ber jede Schwelle
+doch schon Wasserstr?me laufen.
+Ein verruchter Besen,
+der nicht h?ren will!
+Stock, der du gewesen,
+steh doch wieder still!
+
+Willst am Ende
+gar nicht lassen?
+Will dich fassen,
+will dich halten
+und das alte Holz behende
+mit dem scharfen Beile spalten.
+
+Seht da kommt er schleppend wieder!
+Wie ich mich nur auf dich werfe,
+gleich, o Kobold, liegst du nieder;
+krachend trifft die glatte Sch?rfe.
+Wahrlich, brav getroffen!
+Seht, er ist entzwei!
+Und nun kann ich hoffen,
+und ich atme frei!
+
+Wehe! wehe!
+Beide Teile
+stehn in Eile
+schon als Knechte
+v?llig fertig in die H?he!
+Helft mir, ach! ihr hohen M?chte!
+
+Und sie laufen! Na? und n?sser
+wirds im Saal und auf den Stufen.
+Welch entsetzliches Gew?sser!
+Herr und Meister! h?r mich rufen! -
+Ach, da kommt der Meister!
+Herr, die Not ist gro?!
+Die ich rief, die Geister
+werd ich nun nicht los.
+
+"In die Ecke,
+Besen, Besen!
+Seids gewesen.
+Denn als Geister
+ruft euch nur zu diesem Zwecke,
+erst hervor der alte Meister."]]>
+	    </arcs:content>
+	  </types:Poem>
+	</rdf:li>
+      </rdf:Bag>
+    </arcs:wrote>
+  </rdf:Description>
+
+  <!-- referenced ressources by goethe -->
+  <rdf:Description rdf:nodeID="goethe_literature">
+    <rdf:li>
+      <types:Ballad rdf:about="http://some.where/ballad/Der_Erlkoenig" arcs:title="Der Erlk?nig" xml:lang="de">
+	<arcs:dateRange rdf:parseType="Resource" xml:base="http://www.w3.org/2001/XMLSchema">
+	  <arcs:start rdf:datatype="#date">01.01.1782</arcs:start>
+	  <arcs:end  rdf:datatype="#date">31.12.1782</arcs:end>
+	</arcs:dateRange>
+	<arcs:content rdf:datatype="http://www.w3.org/2001/XMLSchema#string" xml:lang="de">
+	  <![CDATA[Wer reitet so sp?t durch Nacht und Wind?
+Es ist der Vater mit seinem Kind;
+Er hat den Knaben wohl in dem Arm,
+Er fa?t ihn sicher, er h?lt ihn warm.
+
+Mein Sohn, was birgst du so bang dein Gesicht? -
+Siehst Vater, du den Erlk?nig nicht?
+Den Erlenk?nig mit Kron und Schweif? -
+Mein Sohn, es ist ein Nebelstreif. -
+
+"Du liebes Kind, komm, geh mit mir!
+Gar sch?ne Spiele spiel ich mit dir;
+Manch bunte Blumen sind an dem Strand,
+Meine Mutter hat manch g?lden Gewand."
+
+Mein Vater, mein Vater, und h?rest du nicht,
+Was Erlenk?nig mir leise verspricht? -
+Sei ruhig, bleibe ruhig, mein Kind;
+In d?rren Bl?ttern s?uselt der Wind. -
+
+"Willst, feiner Knabe, du mit mir gehn?
+Meine T?chter sollen dich warten sch?n;
+Meine T?chter f?hren den n?chtlichen Reihn
+Und wiegen und tanzen und singen dich ein."
+
+Mein Vater, mein Vater, und siehst du nicht dort
+Erlk?nigs T?chter am d?stern Ort? -
+Mein Sohn, mein Sohn, ich seh es genau:
+Es scheinen die alten Weiden so grau. -
+
+"Ich liebe dich, mich reizt deine sch?ne Gestalt;
+Und bist du nicht willig, so brauch ich Gewalt."
+Mein Vater, mein Vater, jetzt fa?t er mich an!
+Erlk?nig hat mir ein Leids getan! -
+
+Dem Vater grauset's, er reitet geschwind,
+Er h?lt in den Armen das ?chzende Kind,
+Erreicht den Hof mit M?he und Not;
+In seinen Armen das Kind war tot.]]>
+	</arcs:content>
+      </types:Ballad>
+    </rdf:li>
+    <rdf:li>
+      <rdf:Description rdf:about="http://some.where/poem/Prometheus" arcs:title="Prometheus">
+	<rdf:type rdf:resource="/types/Poem"/>
+	<arcs:dateRange>
+	  <rdf:Description xml:base="http://does.not.exist">
+	    <arcs:start rdf:datatype="http://www.w3.org/2001/XMLSchema#date">1772</arcs:start>
+	    <arcs:end rdf:datatype="http://www.w3.org/2001/XMLSchema#date">1774</arcs:end>
+	  </rdf:Description>
+	</arcs:dateRange>
+	<arcs:content rdf:parseType="Literal" xml:lang="de">
+	  <![CDATA[Bedecke deinen Himmel, Zeus,
+Mit Wolkendunst!
+Und ?be, Knaben gleich,
+Der Disteln k?pft,
+An Eichen dich und Bergesh?h'n!
+Mu?t mir meine Erde
+Doch lassen steh'n,
+Und meine H?tte,
+Die du nicht gebaut,
+Und meinen Herd,
+Um dessen Glut
+Du mich beneidest.
+
+Ich kenne nichts ?rmeres
+Unter der Sonn' als euch G?tter!
+Ihr n?hret k?mmerlich
+Von Opfersteuern
+Und Gebetshauch
+Eure Majest?t
+Und darbtet, w?ren
+Nicht Kinder und Bettler
+Hoffnungsvolle Toren.
+
+Da ich ein Kind war,
+Nicht wu?te, wo aus, wo ein,
+Kehrt' ich mein verirrtes Auge
+Zur Sonne, als wenn dr?ber w?r
+Ein Ohr zu h?ren meine Klage,
+Ein Herz wie meins,
+Sich des Bedr?ngten zu erbarmen.
+
+Wer half mir
+Wider der Titanen ?bermut?
+Wer rettete vom Tode mich,
+Von Sklaverei?
+Hast du's nicht alles selbst vollendet,
+Heilig gl?hend Herz?
+Und gl?htest, jung und gut,
+Betrogen, Rettungsdank
+Dem Schlafenden dadroben?
+
+Ich dich ehren? Wof?r?
+Hast du die Schmerzen gelindert
+Je des Beladenen?
+Hast du die Tr?nen gestillet
+Je des Ge?ngsteten?
+Hat nicht mich zum Manne geschmiedet
+Die allm?chtige Zeit
+Und das ewige Schicksal,
+Meine Herren und deine?
+
+W?hntest du etwa,
+Ich sollte das Leben hassen,
+In W?sten fliehn,
+Weil nicht alle Knabenmorgen-
+Bl?tentr?ume reiften?
+
+Hier sitz' ich, forme Menschen
+Nach meinem Bilde,
+Ein Geschlecht, das mir gleich sei,
+Zu leiden, weinen,
+Genie?en und zu freuen sich,
+Und dein nicht zu achten,
+Wie ich!]]>
+	</arcs:content>
+      </rdf:Description>
+    </rdf:li>
+  </rdf:Description>
+
+  <rdf:Description rdf:about="http://some.where/language/German">
+    <rdf:type rdf:resource="types/Language"/>
+  </rdf:Description>
+</rdf:RDF>

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 Aug  6 11:46:11 2009
@@ -52,7 +52,8 @@
 	   :test-parse-properties-of-node
 	   :test-import-node-1
 	   :test-import-node-reification
-	   :test-import-dom))
+	   :test-import-dom
+	   :test-poems-rdf-1))
 
 (declaim (optimize (debug 3) (speed 0) (safety 3) (space 0) (compilation-speed 0)))
 
@@ -65,16 +66,6 @@
 (in-suite rdf-importer-test)
 
 
-(defun rdf-init-db (&key (db-dir "data_base") (start-revision (get-revision)))
-  "Empties the data base files and initializes isidorus for rdf."
-  (when elephant:*store-controller*
-    (elephant:close-store))
-  (clean-out-db db-dir)
-  (elephant:open-store (xml-importer:get-store-spec db-dir))
-  (xml-importer:init-isidorus start-revision)
-  (rdf-importer:init-rdf-module start-revision))
-
-
 (test test-get-literals-of-node
   "Tests the helper function get-literals-of-node."
   (let ((doc-1
@@ -1727,6 +1718,24 @@
   (elephant:close-store))
 
 
+(test test-poems-rdf-1
+  "Tests general functionality of the rdf-importer module with the file
+   poems_light.rdf."
+  (elephant:close-store) ;TODO: remove
+  (with-fixture rdf-test-db ()
+    (let ((topics (elephant:get-instances-by-class 'd:TopicC))
+	  (occs (elephant:get-instances-by-class 'd:OccurrenceC))
+	  (assocs (elephant:get-instances-by-class 'd:AssociationC)))
+      (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 65))
+      (is (= (length (elephant:get-instances-by-class 'd:OccurrenceC)) 23))
+      (is (= (length (elephant:get-instances-by-class 'd:AssociationC)) 30))
+      
+
+      ))
+  (elephant:open-store (xml-importer:get-store-spec "data_base"))) ;TODO: remove
+
+
+
 
 (defun run-rdf-importer-tests()
   (it.bese.fiveam:run! 'test-get-literals-of-node)
@@ -1740,4 +1749,5 @@
   (it.bese.fiveam:run! 'test-parse-properties-of-node)
   (it.bese.fiveam:run! 'test-import-node-1)
   (it.bese.fiveam:run! 'test-import-node-reification)
-  (it.bese.fiveam:run! 'test-import-dom))
\ No newline at end of file
+  (it.bese.fiveam:run! 'test-import-dom)
+  (it.bese.fiveam:run! 'test-poems-rdf-1))
\ No newline at end of file

Modified: trunk/src/unit_tests/unittests-constants.lisp
==============================================================================
--- trunk/src/unit_tests/unittests-constants.lisp	(original)
+++ trunk/src/unit_tests/unittests-constants.lisp	Thu Aug  6 11:46:11 2009
@@ -28,7 +28,8 @@
 	   :*sample_objects.xtm*             
 	   :*t100.xtm*
 	   :*atom_test.xtm*
-	   :*atom-conf.lisp*))
+	   :*atom-conf.lisp*
+	   :*poems_light.rdf*))
 
 (in-package :unittests-constants)
 
@@ -89,3 +90,7 @@
 (defparameter *atom-conf.lisp*
   (asdf:component-pathname
    (asdf:find-component *unit-tests-component* "atom-conf")))
+
+(defparameter *poems_light.rdf*
+  (asdf:component-pathname
+   (asdf:find-component *unit-tests-component* "poems_light.rdf")))
\ No newline at end of file

Modified: trunk/src/xml/rdf/rdf_tools.lisp
==============================================================================
--- trunk/src/xml/rdf/rdf_tools.lisp	(original)
+++ trunk/src/xml/rdf/rdf_tools.lisp	Thu Aug  6 11:46:11 2009
@@ -75,10 +75,10 @@
 (in-package :rdf-importer)
 
 (defvar *rdf-types* (list "Description" "List" "Alt" "Bag" "Seq"
-			  "Statement" "Property" "XMLLiteral"))
+			  "Statement" "Property" "XMLLiteral" "nil"))
 
 (defvar *rdf-properties* (list "type" "first" "rest" "subject" "predicate"
-			       "object" "li"))
+			       "object" "li" "first" "rest"))
 
 (defvar *rdfs-types* (list "Resource" "Literal" "Class" "Datatype"
 			   "Container" "ContainerMembershipProperty"))



From lgiessmann at common-lisp.net  Thu Aug  6 18:05:09 2009
From: lgiessmann at common-lisp.net (Lukas Giessmann)
Date: Thu, 06 Aug 2009 14:05:09 -0400
Subject: [isidorus-cvs] r110 - trunk/src/unit_tests
Message-ID: <E1MZ7Kv-0003dM-Af@common-lisp.net>

Author: lgiessmann
Date: Thu Aug  6 14:05:08 2009
New Revision: 110

Log:
added some unit tests for the rdf-importer

Modified:
   trunk/src/unit_tests/fixtures.lisp
   trunk/src/unit_tests/rdf_importer_test.lisp

Modified: trunk/src/unit_tests/fixtures.lisp
==============================================================================
--- trunk/src/unit_tests/fixtures.lisp	(original)
+++ trunk/src/unit_tests/fixtures.lisp	Thu Aug  6 14:05:08 2009
@@ -186,6 +186,7 @@
 	(tm-id "http://test-tm/")
 	(document-id "doc-id"))
     (clean-out-db db-dir)
+    (setf d:*current-xtm* document-id)
     (rdf-importer:setup-rdf-module *poems_light.rdf* db-dir :tm-id tm-id
 				   :document-id document-id)
     (elephant:open-store (xml-importer:get-store-spec db-dir))

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 Aug  6 14:05:08 2009
@@ -32,7 +32,8 @@
 		*rdf-subject*
 		*rdf-object*
 		*rdf-predicate*
-		*rdf-statement*)
+		*rdf-statement*
+		*xml-string*)
   (:import-from :xml-tools
                 xpath-child-elems-by-qname
 		xpath-single-child-elem-by-qname
@@ -53,7 +54,8 @@
 	   :test-import-node-1
 	   :test-import-node-reification
 	   :test-import-dom
-	   :test-poems-rdf-1))
+	   :test-poems-rdf-occurrences
+	   :test-poems-rdf-associations))
 
 (declaim (optimize (debug 3) (speed 0) (safety 3) (space 0) (compilation-speed 0)))
 
@@ -1718,26 +1720,113 @@
   (elephant:close-store))
 
 
-(test test-poems-rdf-1
+(test test-poems-rdf-occurrences
   "Tests general functionality of the rdf-importer module with the file
    poems_light.rdf."
-  (elephant:close-store) ;TODO: remove
   (with-fixture rdf-test-db ()
     (let ((topics (elephant:get-instances-by-class 'd:TopicC))
 	  (occs (elephant:get-instances-by-class 'd:OccurrenceC))
-	  (assocs (elephant:get-instances-by-class 'd:AssociationC)))
-      (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 65))
-      (is (= (length (elephant:get-instances-by-class 'd:OccurrenceC)) 23))
-      (is (= (length (elephant:get-instances-by-class 'd:AssociationC)) 30))
-      
+	  (assocs (elephant:get-instances-by-class 'd:AssociationC))
+	  (arcs "http://some.where/relationship/")
+	  (date "http://www.w3.org/2001/XMLSchema#date")
+	  (long "http://www.w3.org/2001/XMLSchema#unsignedLong"))
+      (is (= (length topics) 65))
+      (is (= (length occs) 23))
+      (is (= (length assocs) 30))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (= (length (d:psis (d:instance-of x))) 1)
+		       (string= (d:uri (first (d:psis (d:instance-of x))))
+				(concatenate 'string arcs "firstName"))
+		       (string= *xml-string* (d:datatype x))))
+	      occs)
+	     1))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (= (length (d:psis (d:instance-of x))) 1)
+		       (string= (d:uri (first (d:psis (d:instance-of x))))
+				(concatenate 'string arcs "lastName"))
+		       (string= *xml-string* (d:datatype x))))
+	      occs)
+	     1))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (= (length (d:psis (d:instance-of x))) 1)
+		       (string= (d:uri (first (d:psis (d:instance-of x))))
+				(concatenate 'string arcs "fullName"))
+		       (string= *xml-string* (d:datatype x))))
+	      occs)
+	     2))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (= (length (d:psis (d:instance-of x))) 1)
+		       (string= (d:uri (first (d:psis (d:instance-of x))))
+				(concatenate 'string arcs "nativeName"))
+		       (string= *xml-string* (d:datatype x))))
+	      occs)
+	     1))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (= (length (d:psis (d:instance-of x))) 1)
+		       (string= (d:uri (first (d:psis (d:instance-of x))))
+				(concatenate 'string arcs "title"))
+		       (string= *xml-string* (d:datatype x))))
+	      occs)
+	     3))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (= (length (d:psis (d:instance-of x))) 1)
+		       (string= (d:uri (first (d:psis (d:instance-of x))))
+				(concatenate 'string arcs "content"))
+		       (string= *xml-string* (d:datatype x))))
+	      occs)
+	     3))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (= (length (d:psis (d:instance-of x))) 1)
+		       (string= (d:uri (first (d:psis (d:instance-of x))))
+				(concatenate 'string arcs "population"))
+		       (string= long (d:datatype x))))
+	      occs)
+	     3))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (= (length (d:psis (d:instance-of x))) 1)
+		       (string= (d:uri (first (d:psis (d:instance-of x))))
+				(concatenate 'string arcs "date"))
+		       (string= date (d:datatype x))))
+	      occs)
+	     2))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (= (length (d:psis (d:instance-of x))) 1)
+		       (string= (d:uri (first (d:psis (d:instance-of x))))
+				(concatenate 'string arcs "start"))
+		       (string= date (d:datatype x))))
+	      occs)
+	     3))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (= (length (d:psis (d:instance-of x))) 1)
+		       (string= (d:uri (first (d:psis (d:instance-of x))))
+				(concatenate 'string arcs "end"))
+		       (string= date (d:datatype x))))
+	      occs)
+	     3)))))
+
 
-      ))
-  (elephant:open-store (xml-importer:get-store-spec "data_base"))) ;TODO: remove
+(test test-poems-rdf-associations
+  "Tests general functionality of the rdf-importer module with the file
+   poems_light.rdf."
+  (with-fixture rdf-test-db ()
 
+    ))
 
 
 
 (defun run-rdf-importer-tests()
+  (when elephant:*store-controller*
+    (elephant:close-store))
   (it.bese.fiveam:run! 'test-get-literals-of-node)
   (it.bese.fiveam:run! 'test-parse-node)
   (it.bese.fiveam:run! 'test-get-literals-of-property)
@@ -1750,4 +1839,5 @@
   (it.bese.fiveam:run! 'test-import-node-1)
   (it.bese.fiveam:run! 'test-import-node-reification)
   (it.bese.fiveam:run! 'test-import-dom)
-  (it.bese.fiveam:run! 'test-poems-rdf-1))
\ No newline at end of file
+  (it.bese.fiveam:run! 'test-poems-rdf-occurrences)
+  (it.bese.fiveam:run! 'test-poems-rdf-associations))
\ No newline at end of file



From lgiessmann at common-lisp.net  Fri Aug  7 15:48:42 2009
From: lgiessmann at common-lisp.net (Lukas Giessmann)
Date: Fri, 07 Aug 2009 11:48:42 -0400
Subject: [isidorus-cvs] r111 - in trunk/src: . unit_tests xml/rdf
Message-ID: <E1MZRgP-00015g-Ux@common-lisp.net>

Author: lgiessmann
Date: Fri Aug  7 11:48:40 2009
New Revision: 111

Log:
finalized the unit tests for poems.rdf

Modified:
   trunk/src/constants.lisp
   trunk/src/unit_tests/poems.rdf
   trunk/src/unit_tests/poems_light.rdf
   trunk/src/unit_tests/rdf_importer_test.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	Fri Aug  7 11:48:40 2009
@@ -37,7 +37,8 @@
 	   :*rdf-rest*
 	   :*rdf2tm-object*
 	   :*rdf2tm-subject*
-	   :*rdf2tm-collection*))
+	   :*rdf2tm-collection*
+	   :*rdf2tm-scope-prefix*))
 
 (in-package :constants)
 (defparameter *xtm2.0-ns* "http://www.topicmaps.org/xtm/")
@@ -94,4 +95,6 @@
 
 (defparameter *rdf2tm-subject* "http://isidorus/rdf2tm_mapping#subject")
 
-(defparameter *rdf2tm-collection* "http://isidorus/rdf2tm_mapping#collection")
\ No newline at end of file
+(defparameter *rdf2tm-collection* "http://isidorus/rdf2tm_mapping#collection")
+
+(defparameter *rdf2tm-scope-prefix* "http://isidorus/rdf2tm_mapping/scope#")
\ No newline at end of file

Modified: trunk/src/unit_tests/poems.rdf
==============================================================================
--- trunk/src/unit_tests/poems.rdf	(original)
+++ trunk/src/unit_tests/poems.rdf	Fri Aug  7 11:48:40 2009
@@ -16,7 +16,7 @@
       <types:Event>
 	<arcs:date rdf:datatype="http://www.w3.org/2001/XMLSchema#date">28.08.1749</arcs:date>
 	<arcs:place>
-	  <rdf:Description rdf:about="/region/FrankfurtMain">
+	  <rdf:Description rdf:about="/metropolis/FrankfurtMain">
 	    <rdf:type>
 	      <rdf:Description rdf:about="/types/Metropolis">
 		<rdfs:subClassOf rdf:resource="/types/Region"/>
@@ -33,7 +33,7 @@
 		<arcs:population rdf:datatype="http://www.w3.org/2001/XMLSchema#unsignedLong">82099232</arcs:population>
 		<arcs:officialese rdf:resource="language/German"/>
 		<arcs:capital>
-		  <rdf:Description rdf:about="http://some.where/region/Berlin">
+		  <rdf:Description rdf:about="http://some.where/metropolis/Berlin">
 		    <rdf:type>
 		      <rdf:Description rdf:about="http://some.where/types/Metropolis"/>
 		    </rdf:type>
@@ -54,9 +54,9 @@
 	<rdf:type rdf:resource="Event"/>
 	<arcs:date rdf:datatype="#date" xml:base="http://www.w3.org/2001/XMLSchema">22.03.1832</arcs:date>
 	<arcs:place xml:base="">
-	  <types:City rdf:about="Weimar" arcs:fullName="Weimar">
+	  <types:City rdf:about="http://some.where/city/Weimar" arcs:fullName="Weimar">
 	    <rdfs:subClassOf rdf:resource="http://some.where/types/Region"/>
-	    <arcs:population rdf:datatype="http://www.w3.org/2001/XMLSchema#unsigneLong">64720</arcs:population>
+	    <arcs:population rdf:datatype="http://www.w3.org/2001/XMLSchema#unsignedLong">64720</arcs:population>
 	    <arcs:locatedIn rdf:resource="http://some.where/country/Germany"/>
 	  </types:City>
 	</arcs:place>

Modified: trunk/src/unit_tests/poems_light.rdf
==============================================================================
--- trunk/src/unit_tests/poems_light.rdf	(original)
+++ trunk/src/unit_tests/poems_light.rdf	Fri Aug  7 11:48:40 2009
@@ -16,7 +16,7 @@
       <types:Event>
 	<arcs:date rdf:datatype="http://www.w3.org/2001/XMLSchema#date">28.08.1749</arcs:date>
 	<arcs:place>
-	  <rdf:Description rdf:about="/region/FrankfurtMain">
+	  <rdf:Description rdf:about="/metropolis/FrankfurtMain">
 	    <rdf:type>
 	      <rdf:Description rdf:about="/types/Metropolis">
 		<rdfs:subClassOf rdf:resource="/types/Region"/>
@@ -33,7 +33,7 @@
 		<arcs:population rdf:datatype="http://www.w3.org/2001/XMLSchema#unsignedLong">82099232</arcs:population>
 		<arcs:officialese rdf:resource="language/German"/>
 		<arcs:capital>
-		  <rdf:Description rdf:about="http://some.where/region/Berlin">
+		  <rdf:Description rdf:about="http://some.where/metropolis/Berlin">
 		    <rdf:type>
 		      <rdf:Description rdf:about="http://some.where/types/Metropolis"/>
 		    </rdf:type>
@@ -54,9 +54,9 @@
 	<rdf:type rdf:resource="Event"/>
 	<arcs:date rdf:datatype="#date" xml:base="http://www.w3.org/2001/XMLSchema">22.03.1832</arcs:date>
 	<arcs:place xml:base="">
-	  <types:City rdf:about="Weimar" arcs:fullName="Weimar">
+	  <types:City rdf:about="http://some.where/city/Weimar" arcs:fullName="Weimar">
 	    <rdfs:subClassOf rdf:resource="http://some.where/types/Region"/>
-	    <arcs:population rdf:datatype="http://www.w3.org/2001/XMLSchema#unsigneLong">64720</arcs:population>
+	    <arcs:population rdf:datatype="http://www.w3.org/2001/XMLSchema#unsignedLong">64720</arcs:population>
 	    <arcs:locatedIn rdf:resource="http://some.where/country/Germany"/>
 	  </types:City>
 	</arcs:place>

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	Fri Aug  7 11:48:40 2009
@@ -55,7 +55,9 @@
 	   :test-import-node-reification
 	   :test-import-dom
 	   :test-poems-rdf-occurrences
-	   :test-poems-rdf-associations))
+	   :test-poems-rdf-associations
+	   :test-poems-rdf-typing
+	   :test-poems-rdf-topics))
 
 (declaim (optimize (debug 3) (speed 0) (safety 3) (space 0) (compilation-speed 0)))
 
@@ -1728,17 +1730,31 @@
 	  (occs (elephant:get-instances-by-class 'd:OccurrenceC))
 	  (assocs (elephant:get-instances-by-class 'd:AssociationC))
 	  (arcs "http://some.where/relationship/")
+	  (goethe "http://some.where/author/Goethe")
+	  (weimar "http://some.where/city/Weimar")
+	  (berlin "http://some.where/metropolis/Berlin")
+	  (frankfurt "http://some.where/metropolis/FrankfurtMain")
+	  (germany "http://some.where/country/Germany")
+	  (zauberlehrling "http://some.where/poem/Der_Zauberlehrling")
+	  (prometheus "http://some.where/poem/Prometheus")
+	  (erlkoenig "http://some.where/ballad/Der_Erlkoenig")
 	  (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 occs) 23))
       (is (= (length assocs) 30))
+      (is-true de)
       (is (= (count-if
 	      #'(lambda(x)
 		  (and (= (length (d:psis (d:instance-of x))) 1)
 		       (string= (d:uri (first (d:psis (d:instance-of x))))
 				(concatenate 'string arcs "firstName"))
-		       (string= *xml-string* (d:datatype x))))
+		       (string= *xml-string* (d:datatype x))
+		       (= (length (d:themes x)) 0)
+		       (= (length (d:psis (d:topic x))) 1)
+		       (string= (d:uri (first (d:psis (d:topic x))))
+				goethe)))
 	      occs)
 	     1))
       (is (= (count-if
@@ -1746,7 +1762,11 @@
 		  (and (= (length (d:psis (d:instance-of x))) 1)
 		       (string= (d:uri (first (d:psis (d:instance-of x))))
 				(concatenate 'string arcs "lastName"))
-		       (string= *xml-string* (d:datatype x))))
+		       (string= *xml-string* (d:datatype x))
+		       (= (length (d:themes x)) 0)
+		       (= (length (d:psis (d:topic x))) 1)
+		       (string= (d:uri (first (d:psis (d:topic x))))
+				goethe)))
 	      occs)
 	     1))
       (is (= (count-if
@@ -1754,15 +1774,61 @@
 		  (and (= (length (d:psis (d:instance-of x))) 1)
 		       (string= (d:uri (first (d:psis (d:instance-of x))))
 				(concatenate 'string arcs "fullName"))
-		       (string= *xml-string* (d:datatype x))))
+		       (string= *xml-string* (d:datatype x))
+		       (= (length (d:themes x)) 0)
+		       (= (length (d:psis (d:topic x))) 1)
+		       (string= (d:uri (first (d:psis (d:topic x))))
+				weimar)))
 	      occs)
-	     2))
+	     1))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (= (length (d:psis (d:instance-of x))) 1)
+		       (string= (d:uri (first (d:psis (d:instance-of x))))
+				(concatenate 'string arcs "fullName"))
+		       (string= *xml-string* (d:datatype x))
+		       (= (length (d:themes x)) 0)
+		       (= (length (d:psis (d:topic x))) 1)
+		       (string= (d:uri (first (d:psis (d:topic x))))
+				frankfurt)))
+	      occs)
+	     1))
       (is (= (count-if
 	      #'(lambda(x)
 		  (and (= (length (d:psis (d:instance-of x))) 1)
 		       (string= (d:uri (first (d:psis (d:instance-of x))))
 				(concatenate 'string arcs "nativeName"))
-		       (string= *xml-string* (d:datatype x))))
+		       (string= *xml-string* (d:datatype x))
+		       (= 1 (length (d:themes x)))
+		       (eql (first (d:themes x)) de)
+		       (= (length (d:psis (d:topic x))) 1)
+		       (string= (d:uri (first (d:psis (d:topic x))))
+				germany)))
+	      occs)
+	     1))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (= (length (d:psis (d:instance-of x))) 1)
+		       (string= (d:uri (first (d:psis (d:instance-of x))))
+				(concatenate 'string arcs "title"))
+		       (string= *xml-string* (d:datatype x))
+		       (= 1 (length (d:themes x)))
+		       (eql (first (d:themes x)) de)
+		       (= (length (d:psis (d:topic x))) 1)
+		       (string= (d:uri (first (d:psis (d:topic x))))
+				zauberlehrling)))
+	      occs)
+	     1))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (= (length (d:psis (d:instance-of x))) 1)
+		       (string= (d:uri (first (d:psis (d:instance-of x))))
+				(concatenate 'string arcs "title"))
+		       (= 0 (length (d:themes x)))
+		       (string= *xml-string* (d:datatype x))
+		       (= (length (d:psis (d:topic x))) 1)
+		       (string= (d:uri (first (d:psis (d:topic x))))
+				prometheus)))
 	      occs)
 	     1))
       (is (= (count-if
@@ -1770,31 +1836,109 @@
 		  (and (= (length (d:psis (d:instance-of x))) 1)
 		       (string= (d:uri (first (d:psis (d:instance-of x))))
 				(concatenate 'string arcs "title"))
-		       (string= *xml-string* (d:datatype x))))
+		       (string= *xml-string* (d:datatype x))
+		       (= 1 (length (d:themes x)))
+		       (eql (first (d:themes x)) de)
+		       (= (length (d:psis (d:topic x))) 1)
+		       (string= (d:uri (first (d:psis (d:topic x))))
+				erlkoenig)))
+	      occs)
+	     1))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (= (length (d:psis (d:instance-of x))) 1)
+		       (string= (d:uri (first (d:psis (d:instance-of x))))
+				(concatenate 'string arcs "content"))
+		       (string= *xml-string* (d:datatype x))
+		       (= 1 (length (d:themes x)))
+		       (eql (first (d:themes x)) de)
+		       (= (length (d:psis (d:topic x))) 1)
+		       (string= (d:uri (first (d:psis (d:topic x))))
+				zauberlehrling)))
+	      occs)
+	     1))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (= (length (d:psis (d:instance-of x))) 1)
+		       (string= (d:uri (first (d:psis (d:instance-of x))))
+				(concatenate 'string arcs "content"))
+		       (string= *xml-string* (d:datatype x))
+		       (= 1 (length (d:themes x)))
+		       (eql (first (d:themes x)) de)
+		       (= (length (d:psis (d:topic x))) 1)
+		       (string= (d:uri (first (d:psis (d:topic x))))
+				prometheus)))
 	      occs)
-	     3))
+	     1))
       (is (= (count-if
 	      #'(lambda(x)
 		  (and (= (length (d:psis (d:instance-of x))) 1)
 		       (string= (d:uri (first (d:psis (d:instance-of x))))
 				(concatenate 'string arcs "content"))
-		       (string= *xml-string* (d:datatype x))))
+		       (string= *xml-string* (d:datatype x))
+		       (= 1 (length (d:themes x)))
+		       (eql (first (d:themes x)) de)
+		       (= (length (d:psis (d:topic x))) 1)
+		       (string= (d:uri (first (d:psis (d:topic x))))
+				erlkoenig)))
+	      occs)
+	     1))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (= (length (d:psis (d:instance-of x))) 1)
+		       (string= (d:uri (first (d:psis (d:instance-of x))))
+				(concatenate 'string arcs "population"))
+		       (string= long (d:datatype x))
+		       (= 0 (length (d:themes x)))
+		       (= (length (d:psis (d:topic x))) 1)
+		       (string= (d:uri (first (d:psis (d:topic x))))
+				weimar)))
+	      occs)
+	     1))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (= (length (d:psis (d:instance-of x))) 1)
+		       (string= (d:uri (first (d:psis (d:instance-of x))))
+				(concatenate 'string arcs "population"))
+		       (string= long (d:datatype x))
+		       (= 0 (length (d:themes x)))
+		       (= (length (d:psis (d:topic x))) 1)
+		       (string= (d:uri (first (d:psis (d:topic x))))
+				frankfurt)))
+	      occs)
+	     1))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (= (length (d:psis (d:instance-of x))) 1)
+		       (string= (d:uri (first (d:psis (d:instance-of x))))
+				(concatenate 'string arcs "population"))
+		       (string= long (d:datatype x))
+		       (= 0 (length (d:themes x)))
+		       (= (length (d:psis (d:topic x))) 1)
+		       (string= (d:uri (first (d:psis (d:topic x))))
+				berlin)))
 	      occs)
-	     3))
+	     1))
       (is (= (count-if
 	      #'(lambda(x)
 		  (and (= (length (d:psis (d:instance-of x))) 1)
 		       (string= (d:uri (first (d:psis (d:instance-of x))))
 				(concatenate 'string arcs "population"))
-		       (string= long (d:datatype x))))
+		       (string= long (d:datatype x))
+		       (= 0 (length (d:themes x)))
+		       (= (length (d:psis (d:topic x))) 1)
+		       (string= (d:uri (first (d:psis (d:topic x))))
+				germany)))
 	      occs)
-	     3))
+	     1))
       (is (= (count-if
 	      #'(lambda(x)
 		  (and (= (length (d:psis (d:instance-of x))) 1)
 		       (string= (d:uri (first (d:psis (d:instance-of x))))
 				(concatenate 'string arcs "date"))
-		       (string= date (d:datatype x))))
+		       (string= date (d:datatype x))
+		       (= 0 (length (d:themes x)))
+		       (= (length (d:psis (d:topic x))) 0)))
 	      occs)
 	     2))
       (is (= (count-if
@@ -1802,26 +1946,763 @@
 		  (and (= (length (d:psis (d:instance-of x))) 1)
 		       (string= (d:uri (first (d:psis (d:instance-of x))))
 				(concatenate 'string arcs "start"))
-		       (string= date (d:datatype x))))
+		       (string= date (d:datatype x))
+		       (= 1 (length (d:themes x)))
+		       (eql (first (d:themes x)) de)
+		       (= (length (d:psis (d:topic x))) 0)))
+	      
+	      occs)
+	     1))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (= (length (d:psis (d:instance-of x))) 1)
+		       (string= (d:uri (first (d:psis (d:instance-of x))))
+				(concatenate 'string arcs "start"))
+		       (string= date (d:datatype x))
+		       (= 0 (length (d:themes x)))
+		       (= (length (d:psis (d:topic x))) 0)))
+	      
+	      occs)
+	     2))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (= (length (d:psis (d:instance-of x))) 1)
+		       (string= (d:uri (first (d:psis (d:instance-of x))))
+				(concatenate 'string arcs "end"))
+		       (string= date (d:datatype x))
+		       (= 1 (length (d:themes x)))
+		       (eql (first (d:themes x)) de)
+		       (= (length (d:psis (d:topic x))) 0)))
 	      occs)
-	     3))
+	     1))
       (is (= (count-if
 	      #'(lambda(x)
 		  (and (= (length (d:psis (d:instance-of x))) 1)
 		       (string= (d:uri (first (d:psis (d:instance-of x))))
 				(concatenate 'string arcs "end"))
-		       (string= date (d:datatype x))))
+		       (string= date (d:datatype x))
+		       (= 0 (length (d:themes x)))
+		       (= (length (d:psis (d:topic x))) 0)))
 	      occs)
-	     3)))))
+	     2)))))
 
 
 (test test-poems-rdf-associations
   "Tests general functionality of the rdf-importer module with the file
    poems_light.rdf."
   (with-fixture rdf-test-db ()
+    (let ((assocs (elephant:get-instances-by-class 'd:AssociationC))
+	  (isi-object (d:get-item-by-psi constants::*rdf2tm-object*))
+	  (isi-subject (d:get-item-by-psi constants::*rdf2tm-subject*))
+	  (arcs "http://some.where/relationship/")
+	  (goethe "http://some.where/author/Goethe")
+	  (germany "http://some.where/country/Germany")
+	  (berlin "http://some.where/metropolis/Berlin")
+	  (german "http://some.where/language/German")
+	  (frankfurt "http://some.where/metropolis/FrankfurtMain")
+	  (weimar "http://some.where/city/Weimar")
+	  (zauberlehrling "http://some.where/poem/Der_Zauberlehrling")
+	  (prometheus "http://some.where/poem/Prometheus")
+	  (erlkoenig "http://some.where/ballad/Der_Erlkoenig"))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (= (length (d:psis (d:instance-of x))) 1)
+		       (string= (d:uri (first (d:psis (d:instance-of x))))
+				(concatenate 'string arcs "born"))
+		       (= (length (d:roles x)) 2)
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) isi-subject)
+				 (= (length (d:psis (d:player y))) 1)
+				 (string= (d:uri (first (d:psis (d:player y))))
+					  goethe)))
+			(d:roles x))
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) isi-object)
+				 (= (length (d:psis (d:player y))) 0)))
+			(d:roles x))))
+	      assocs)
+	     1))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (= (length (d:psis (d:instance-of x))) 1)
+		       (string= (d:uri (first (d:psis (d:instance-of x))))
+				(concatenate 'string arcs "died"))
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) isi-subject)
+				 (= (length (d:psis (d:player y))) 1)
+				 (string= (d:uri (first (d:psis (d:player y))))
+					  goethe)))
+			(d:roles x))
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) isi-object)
+				 (= (length (d:psis (d:player y))) 0)))
+			(d:roles x))))
+	      assocs)
+	     1))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (= (length (d:psis (d:instance-of x))) 1)
+		       (string= (d:uri (first (d:psis (d:instance-of x))))
+				(concatenate 'string arcs "wrote"))
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) isi-subject)
+				 (= (length (d:psis (d:player y))) 1)
+				 (string= (d:uri (first (d:psis (d:player y))))
+					  goethe)))
+			(d:roles x))
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) isi-object)
+				 (= (length (d:psis (d:player y))) 0)))
+			(d:roles x))))
+	      assocs)
+	     1))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (= (length (d:psis (d:instance-of x))) 1)
+		       (string= (d:uri (first (d:psis (d:instance-of x))))
+				(concatenate 'string arcs "capital"))
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) isi-subject)
+				 (= (length (d:psis (d:player y))) 1)
+				 (string= (d:uri (first (d:psis (d:player y))))
+					  germany)))
+			(d:roles x))
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) isi-object)
+				 (= (length (d:psis (d:player y))) 1)
+				 (string= (d:uri (first (d:psis (d:player y))))
+					  berlin)))
+			(d:roles x))))
+	      assocs)
+	     1))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (= (length (d:psis (d:instance-of x))) 1)
+		       (string= (d:uri (first (d:psis (d:instance-of x))))
+				(concatenate 'string arcs "officialese"))
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) isi-subject)
+				 (= (length (d:psis (d:player y))) 1)
+				 (string= (d:uri (first (d:psis (d:player y))))
+					  germany)))
+			(d:roles x))
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) isi-object)
+				 (= (length (d:psis (d:player y))) 1)
+				 (string= (d:uri (first (d:psis (d:player y))))
+					  german)))
+			(d:roles x))))
+	      assocs)
+	     1))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (= (length (d:psis (d:instance-of x))) 1)
+		       (string= (d:uri (first (d:psis (d:instance-of x))))
+				(concatenate 'string arcs "place"))
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) isi-object)
+				 (= (length (d:psis (d:player y))) 1)
+				 (string= (d:uri (first (d:psis (d:player y))))
+					  frankfurt)))
+			(d:roles x))
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) isi-subject)
+				 (= (length (d:psis (d:player y))) 0)))
+			(d:roles x))))
+	      assocs)
+	     1))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (= (length (d:psis (d:instance-of x))) 1)
+		       (string= (d:uri (first (d:psis (d:instance-of x))))
+				(concatenate 'string arcs "place"))
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) isi-object)
+				 (= (length (d:psis (d:player y))) 1)
+				 (string= (d:uri (first (d:psis (d:player y))))
+					  weimar)))
+			(d:roles x))
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) isi-subject)
+				 (= (length (d:psis (d:player y))) 0)))
+			(d:roles x))))
+	      assocs)
+	     1))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (= (length (d:psis (d:instance-of x))) 1)
+		       (string= (d:uri (first (d:psis (d:instance-of x))))
+				(concatenate 'string arcs "locatedIn"))
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) isi-subject)
+				 (= (length (d:psis (d:player y))) 1)
+				 (string= (d:uri (first (d:psis (d:player y))))
+					  frankfurt)))
+			(d:roles x))
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) isi-object)
+				 (= (length (d:psis (d:player y))) 1)
+				 (string= (d:uri (first (d:psis (d:player y))))
+					  germany)))
+			(d:roles x))))
+	      assocs)
+	     1))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (= (length (d:psis (d:instance-of x))) 1)
+		       (string= (d:uri (first (d:psis (d:instance-of x))))
+				(concatenate 'string arcs "locatedIn"))
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) isi-subject)
+				 (= (length (d:psis (d:player y))) 1)
+				 (string= (d:uri (first (d:psis (d:player y))))
+					  weimar)))
+			(d:roles x))
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) isi-object)
+				 (= (length (d:psis (d:player y))) 1)
+				 (string= (d:uri (first (d:psis (d:player y))))
+					  germany)))
+			(d:roles x))))
+	      assocs)
+	     1))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (= (length (d:psis (d:instance-of x))) 1)
+		       (string= (d:uri (first (d:psis (d:instance-of x))))
+				(concatenate 'string arcs "locatedIn"))
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) isi-subject)
+				 (= (length (d:psis (d:player y))) 1)
+				 (string= (d:uri (first (d:psis (d:player y))))
+					  berlin)))
+			(d:roles x))
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) isi-object)
+				 (= (length (d:psis (d:player y))) 1)
+				 (string= (d:uri (first (d:psis (d:player y))))
+					  germany)))
+			(d:roles x))))
+	      assocs)
+	     1))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (= (length (d:psis (d:instance-of x))) 1)
+		       (string= (d:uri (first (d:psis (d:instance-of x))))
+				(concatenate 'string arcs "dateRange"))
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) isi-subject)
+				 (= (length (d:psis (d:player y))) 1)
+				 (string= (d:uri (first (d:psis (d:player y))))
+					  prometheus)))
+			(d:roles x))
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) isi-object)
+				 (= (length (d:psis (d:player y))) 0)))
+			(d:roles x))))
+	      assocs)
+	     1))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (= (length (d:psis (d:instance-of x))) 1)
+		       (string= (d:uri (first (d:psis (d:instance-of x))))
+				(concatenate 'string arcs "dateRange"))
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) isi-subject)
+				 (= (length (d:psis (d:player y))) 1)
+				 (string= (d:uri (first (d:psis (d:player y))))
+					  zauberlehrling)))
+			(d:roles x))
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) isi-object)
+				 (= (length (d:psis (d:player y))) 0)))
+			(d:roles x))))
+	      assocs)
+	     1))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (= (length (d:psis (d:instance-of x))) 1)
+		       (string= (d:uri (first (d:psis (d:instance-of x))))
+				(concatenate 'string arcs "dateRange"))
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) isi-subject)
+				 (= (length (d:psis (d:player y))) 1)
+				 (string= (d:uri (first (d:psis (d:player y))))
+					  erlkoenig)))
+			(d:roles x))
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) isi-object)
+				 (= (length (d:psis (d:player y))) 0)))
+			(d:roles x))))
+	      assocs)
+	     1))
+      (is (= (count-if
+	      #'(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"))
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) isi-subject)
+				 (= (length (d:psis (d:player y))) 0)))
+			(d:roles x))
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) isi-object)
+				 (= (length (d:psis (d:player y))) 1)
+				 (string= (d:uri (first (d:psis (d:player y))))
+					  zauberlehrling)))
+			(d:roles x))))
+	      assocs)
+	     1))
+      (is (= (count-if
+	      #'(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"))
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) isi-subject)
+				 (= (length (d:psis (d:player y))) 0)))
+			(d:roles x))
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) isi-object)
+				 (= (length (d:psis (d:player y))) 1)
+				 (string= (d:uri (first (d:psis (d:player y))))
+					  erlkoenig)))
+			(d:roles x))))
+	      assocs)
+	     1))
+      (is (= (count-if
+	      #'(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"))
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) isi-subject)
+				 (= (length (d:psis (d:player y))) 0)))
+			(d:roles x))
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) isi-object)
+				 (= (length (d:psis (d:player y))) 1)
+				 (string= (d:uri (first (d:psis (d:player y))))
+					  prometheus)))
+			(d:roles x))))
+	      assocs)
+	     1)))))
 
-    ))
 
+(test test-poems-rdf-typing
+  "Tests general functionality of the rdf-importer module with the file
+   poems_light.rdf."
+  (with-fixture rdf-test-db ()
+    (let ((assocs (elephant:get-instances-by-class 'd:AssociationC))
+	  (type (get-item-by-psi constants:*type-psi*))
+	  (instance (get-item-by-psi constants:*instance-psi*))
+	  (type-instance (get-item-by-psi constants:*type-instance-psi*))
+	  (subtype (get-item-by-psi constants:*subtype-psi*))
+	  (supertype (get-item-by-psi constants:*supertype-psi*))
+	  (supertype-subtype
+	   (get-item-by-psi constants:*supertype-subtype-psi*))
+	  (region "http://some.where/types/Region")
+	  (metropolis "http://some.where/types/Metropolis")
+	  (city "http://some.where/types/City")
+	  (frankfurt "http://some.where/metropolis/FrankfurtMain")
+	  (weimar "http://some.where/city/Weimar")
+	  (berlin "http://some.where/metropolis/Berlin")
+	  (language "http://some.where/types/Language")
+	  (german "http://some.where/language/German")
+	  (author "http://some.where/types/Author")
+	  (goethe "http://some.where/author/Goethe")
+	  (bag (concatenate 'string constants::*rdf-ns* "Bag"))
+	  (poem "http://some.where/types/Poem")
+	  (ballad "http://some.where/types/Ballad")
+	  (zauberlehrling "http://some.where/poem/Der_Zauberlehrling")
+	  (prometheus "http://some.where/poem/Prometheus")
+	  (erlkoenig "http://some.where/ballad/Der_Erlkoenig")
+	  (country "http://some.where/types/Country")
+	  
+	  )
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (eql (d:instance-of x) supertype-subtype)
+		       (= (length (d:roles x)) 2)
+		       (= (count-if
+			   #'(lambda(y)
+			       (or (eql (d:instance-of y) supertype)
+				   (eql (d:instance-of y) subtype)))
+			   (d:roles x)))))
+	      assocs)))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (eql (d:instance-of x) supertype-subtype)
+		       (= (length (d:roles x)) 2)
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) supertype)
+				 (= (length (d:psis (d:player y))) 1)
+				 (string= (d:uri (first (d:psis (d:player y))))
+					  region)))
+			(d:roles x))
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) subtype)
+				 (= (length (d:psis (d:player y))) 1)
+				 (string= (d:uri (first (d:psis (d:player y))))
+					  metropolis)))
+			(d:roles x))))
+	      assocs)))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (eql (d:instance-of x) supertype-subtype)
+		       (= (length (d:roles x)) 2)
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) supertype)
+				 (= (length (d:psis (d:player y))) 1)
+				 (string= (d:uri (first (d:psis (d:player y))))
+					  region)))
+			(d:roles x))
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) subtype)
+				 (= (length (d:psis (d:player y))) 1)
+				 (string= (d:uri (first (d:psis (d:player y))))
+					  city)))
+			(d:roles x))))
+	      assocs)))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (eql (d:instance-of x) type-instance)
+		       (= (length (d:roles x)) 2)
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) type)
+				 (= (length (d:psis (d:player y))) 1)
+				 (string= (d:uri (first (d:psis (d:player y))))
+					  metropolis)))
+			(d:roles x))
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) instance)
+				 (= (length (d:psis (d:player y))) 1)
+				 (string= (d:uri (first (d:psis (d:player y))))
+					  frankfurt)))
+			(d:roles x))))
+	      assocs)))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (eql (d:instance-of x) type-instance)
+		       (= (length (d:roles x)) 2)
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) type)
+				 (= (length (d:psis (d:player y))) 1)
+				 (string= (d:uri (first (d:psis (d:player y))))
+					  metropolis)))
+			(d:roles x))
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) instance)
+				 (= (length (d:psis (d:player y))) 1)
+				 (string= (d:uri (first (d:psis (d:player y))))
+					  berlin)))
+			(d:roles x))))
+	      assocs)))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (eql (d:instance-of x) type-instance)
+		       (= (length (d:roles x)) 2)
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) type)
+				 (= (length (d:psis (d:player y))) 1)
+				 (string= (d:uri (first (d:psis (d:player y))))
+					  city)))
+			(d:roles x))
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) instance)
+				 (= (length (d:psis (d:player y))) 1)
+				 (string= (d:uri (first (d:psis (d:player y))))
+					  weimar)))
+			(d:roles x))))
+	      assocs)))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (eql (d:instance-of x) type-instance)
+		       (= (length (d:roles x)) 2)
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) type)
+				 (= (length (d:psis (d:player y))) 1)
+				 (string= (d:uri (first (d:psis (d:player y))))
+					  language)))
+			(d:roles x))
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) instance)
+				 (= (length (d:psis (d:player y))) 1)
+				 (string= (d:uri (first (d:psis (d:player y))))
+					  german)))
+			(d:roles x))))
+	      assocs)))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (eql (d:instance-of x) type-instance)
+		       (= (length (d:roles x)) 2)
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) type)
+				 (= (length (d:psis (d:player y))) 1)
+				 (string= (d:uri (first (d:psis (d:player y))))
+					  bag)))
+			(d:roles x))
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) instance)
+				 (= (length (d:psis (d:player y))) 0)))
+			(d:roles x))))
+	      assocs)))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (eql (d:instance-of x) type-instance)
+		       (= (length (d:roles x)) 2)
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) type)
+				 (= (length (d:psis (d:player y))) 1)
+				 (string= (d:uri (first (d:psis (d:player y))))
+					  author)))
+			(d:roles x))
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) instance)
+				 (= (length (d:psis (d:player y))) 1)
+				 (string= (d:uri (first (d:psis (d:player y))))
+					  goethe)))
+			(d:roles x))))
+	      assocs)))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (eql (d:instance-of x) type-instance)
+		       (= (length (d:roles x)) 2)
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) type)
+				 (= (length (d:psis (d:player y))) 1)
+				 (string= (d:uri (first (d:psis (d:player y))))
+					  ballad)))
+			(d:roles x))
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) instance)
+				 (= (length (d:psis (d:player y))) 1)
+				 (string= (d:uri (first (d:psis (d:player y))))
+					  erlkoenig)))
+			(d:roles x))))
+	      assocs)))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (eql (d:instance-of x) type-instance)
+		       (= (length (d:roles x)) 2)
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) type)
+				 (= (length (d:psis (d:player y))) 1)
+				 (string= (d:uri (first (d:psis (d:player y))))
+					  poem)))
+			(d:roles x))
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) instance)
+				 (= (length (d:psis (d:player y))) 1)
+				 (string= (d:uri (first (d:psis (d:player y))))
+					  zauberlehrling)))
+			(d:roles x))))
+	      assocs)))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (eql (d:instance-of x) type-instance)
+		       (= (length (d:roles x)) 2)
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) type)
+				 (= (length (d:psis (d:player y))) 1)
+				 (string= (d:uri (first (d:psis (d:player y))))
+					  poem)))
+			(d:roles x))
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) instance)
+				 (= (length (d:psis (d:player y))) 1)
+				 (string= (d:uri (first (d:psis (d:player y))))
+					  prometheus)))
+			(d:roles x))))
+	      assocs)))
+      (is (= (count-if
+	      #'(lambda(x)
+		  (and (eql (d:instance-of x) type-instance)
+		       (= (length (d:roles x)) 2)
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) type)
+				 (= (length (d:psis (d:player y))) 1)
+				 (string= (d:uri (first (d:psis (d:player y))))
+					  country)))
+			(d:roles x))
+		       (find-if
+			#'(lambda(y)
+			    (and (eql (d:instance-of y) instance)
+				 (= (length (d:psis (d:player y))) 1)
+				 (string= (d:uri (first (d:psis (d:player y))))
+					  poem)))
+			(d:roles x))))
+	      assocs))))))
+
+
+(defun check-topic (top psi)
+  "A simple helper for test-poems-rdf-topics."
+  (is-true top)
+  (is (= (length (d:psis top)) (if psi 1 0)))
+  (when psi
+    (is (string= (d:uri (first (d:psis top))) psi)))
+  (is (= (length (d:names top)) 0)))
+
+
+(test test-poems-rdf-topics
+  "Tests general functionality of the rdf-importer module with the file
+   poems_light.rdf."
+  (with-fixture rdf-test-db ()
+    (let ((arcs "http://some.where/relationship/")
+	  (types "http://some.where/types/"))
+      (let ((goethe (get-item-by-id "http://some.where/author/Goethe"))
+	    (author (get-item-by-id (concatenate 'string types "Author")))
+	    (first-name (get-item-by-id
+			 (concatenate 'string arcs "firstName")))
+	    (last-name (get-item-by-id
+			(concatenate 'string arcs "lastName")))
+	    (born (get-item-by-id (concatenate 'string arcs "born")))
+	    (event (get-item-by-id (concatenate 'string types "Event")))
+	    (date (get-item-by-id (concatenate 'string arcs "date")))
+	    (place (get-item-by-id (concatenate 'string arcs "place")))
+	    (frankfurt (get-item-by-id
+			"http://some.where/metropolis/FrankfurtMain"))
+	    (metropolis (get-item-by-id (concatenate 'string types
+						     "Metropolis")))
+	    (region (get-item-by-id (concatenate 'string types "Region")))
+	    (population (get-item-by-id (concatenate 'string arcs
+						     "population")))
+	    (locatedIn (get-item-by-id (concatenate 'string arcs
+						    "locatedIn")))
+	    (germany (get-item-by-id "http://some.where/country/Germany"))
+	    (country (get-item-by-id (concatenate 'string types "Country")))
+	    (native-name (get-item-by-id (concatenate 'string arcs
+						      "nativeName")))
+	    (officialese (get-item-by-id (concatenate 'string arcs
+						      "officialese")))
+	    (german (get-item-by-id "http://some.where/language/German"))
+	    (capital (get-item-by-id (concatenate 'string arcs "capital")))
+	    (berlin (get-item-by-id "http://some.where/metropolis/Berlin"))
+	    (died (get-item-by-id (concatenate 'string arcs "died")))
+	    (weimar (get-item-by-id "http://some.where/city/Weimar"))
+	    (city (get-item-by-id (concatenate 'string types "City")))
+	    (wrote (get-item-by-id (concatenate 'string arcs "wrote")))
+	    (goethe-literature (get-item-by-id "goethe_literature"))
+	    (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")))
+	    (zauberlehrling
+	     (get-item-by-id "http://some.where/poem/Der_Zauberlehrling"))
+	    (poem (get-item-by-id (concatenate 'string types "Poem")))
+	    (dateRange (get-item-by-id (concatenate 'string arcs "dateRange")))
+	    (start (get-item-by-id (concatenate 'string arcs "start")))
+	    (end (get-item-by-id (concatenate 'string arcs "end")))
+	    (title (get-item-by-id (concatenate 'string arcs "title")))
+	    (content (get-item-by-id (concatenate 'string arcs "content")))
+	    (erlkoenig (get-item-by-id "http://some.where/ballad/Der_Erlkoenig"))
+	    (ballad (get-item-by-id (concatenate 'string types "Ballad")))
+	    (de (get-item-by-id (concatenate
+				 'string constants::*rdf2tm-scope-prefix*
+				 "de")))
+	    (prometheus (get-item-by-id "http://some.where/poem/Prometheus"))
+	    (language (get-item-by-id (concatenate 'string types "Language")))
+	    (full-name (get-item-by-id (concatenate 'string arcs "fullName"))))
+	(check-topic goethe "http://some.where/author/Goethe")
+	(check-topic author (concatenate 'string types "Author"))
+	(check-topic first-name (concatenate 'string arcs "firstName"))
+	(check-topic last-name (concatenate 'string arcs "lastName"))
+	(check-topic born (concatenate 'string arcs "born"))
+	(check-topic event (concatenate 'string types "Event"))
+	(check-topic date (concatenate 'string arcs "date"))
+	(check-topic place (concatenate 'string arcs "place"))
+	(check-topic frankfurt "http://some.where/metropolis/FrankfurtMain")
+	(check-topic metropolis (concatenate 'string types "Metropolis"))
+	(check-topic region (concatenate 'string types "Region"))
+	(check-topic population (concatenate 'string arcs "population"))
+	(check-topic locatedIn (concatenate 'string arcs "locatedIn"))
+	(check-topic germany "http://some.where/country/Germany")
+	(check-topic country (concatenate 'string types "Country"))
+	(check-topic native-name (concatenate 'string arcs "nativeName"))
+	(check-topic officialese (concatenate 'string arcs "officialese"))
+	(check-topic german "http://some.where/language/German")
+	(check-topic capital (concatenate 'string arcs "capital"))
+	(check-topic berlin "http://some.where/metropolis/Berlin")
+	(check-topic died (concatenate 'string arcs "died"))
+	(check-topic weimar "http://some.where/city/Weimar")
+	(check-topic city (concatenate 'string types "City"))
+	(check-topic wrote (concatenate 'string arcs "wrote"))
+	(check-topic goethe-literature nil)
+	(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 zauberlehrling "http://some.where/poem/Der_Zauberlehrling")
+	(check-topic poem (concatenate 'string types "Poem"))
+	(check-topic dateRange (concatenate 'string arcs "dateRange"))
+	(check-topic start (concatenate 'string arcs "start"))
+	(check-topic end (concatenate 'string arcs "end"))
+	(check-topic title (concatenate 'string arcs "title"))
+	(check-topic content (concatenate 'string arcs "content"))
+	(check-topic erlkoenig "http://some.where/ballad/Der_Erlkoenig")
+	(check-topic ballad (concatenate 'string types "Ballad"))
+	(check-topic de (concatenate 'string constants::*rdf2tm-scope-prefix*
+				     "de"))
+	(check-topic prometheus "http://some.where/poem/Prometheus")
+	(check-topic language (concatenate 'string types "Language"))
+	(check-topic full-name (concatenate 'string arcs "fullName"))
+	(is (= (count-if #'(lambda(x)
+			     (null (d:psis x)))
+			 (elephant:get-instances-by-class 'd:TopicC))
+	       6))))))
 
 
 (defun run-rdf-importer-tests()
@@ -1840,4 +2721,6 @@
   (it.bese.fiveam:run! 'test-import-node-reification)
   (it.bese.fiveam:run! 'test-import-dom)
   (it.bese.fiveam:run! 'test-poems-rdf-occurrences)
-  (it.bese.fiveam:run! 'test-poems-rdf-associations))
\ No newline at end of file
+  (it.bese.fiveam:run! 'test-poems-rdf-associations)
+  (it.bese.fiveam:run! 'test-poems-rdf-typing)
+  (it.bese.fiveam:run! 'test-poems-rdf-topics))
\ 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	Fri Aug  7 11:48:40 2009
@@ -23,8 +23,8 @@
      (get-store-spec repository-path)))
   (xml-importer:init-isidorus)
   (init-rdf-module)
-  (rdf-importer rdf-xml-path repository-path :tm-id tm-id)
-		:document-id document-id
+  (rdf-importer rdf-xml-path repository-path :tm-id tm-id
+		:document-id document-id)
   (when elephant:*store-controller*
     (elephant:close-store)))
 
@@ -409,15 +409,13 @@
 				       topic-id err)))))))))
 
 
-(defun make-lang-topic (lang tm-id start-revision tm
+(defun make-lang-topic (lang start-revision tm
 			&key (document-id *document-id*))
   "Returns a topic with the topicid tm-id/lang. If no such topic exist
    there will be created one."
-  (declare (TopicMapC tm))
-  (when (and lang tm-id)
-    (tm-id-p tm-id "make-lang-topic")
+  (when lang
     (let ((psi-and-topic-id
-	   (absolutize-value lang nil tm-id)))
+	   (concatenate-uri *rdf2tm-scope-prefix* lang)))
       (let ((top (get-item-by-id psi-and-topic-id :xtm-id document-id
 				 :revision start-revision)))
 	(if top
@@ -538,7 +536,7 @@
 	(let ((type-top (make-topic-stub type nil nil nil start-revision
 					 xml-importer::tm
 					 :document-id document-id))
-	      (lang-top (make-lang-topic lang tm-id start-revision
+	      (lang-top (make-lang-topic lang start-revision
 					 xml-importer::tm
 					 :document-id document-id)))
 	  (let ((occurrence

Modified: trunk/src/xml/rdf/rdf_tools.lisp
==============================================================================
--- trunk/src/xml/rdf/rdf_tools.lisp	(original)
+++ trunk/src/xml/rdf/rdf_tools.lisp	Fri Aug  7 11:48:40 2009
@@ -31,7 +31,8 @@
 		*rdf-nil*
 		*rdf-first*
 		*rdf-rest*
-		*rdf2tm-collection*)
+		*rdf2tm-collection*
+		*rdf2tm-scope-prefix*)
   (:import-from :xml-constants
 		*rdf_core_psis.xtm*)
   (:import-from :xml-constants



From lgiessmann at common-lisp.net  Mon Aug 10 10:48:59 2009
From: lgiessmann at common-lisp.net (Lukas Giessmann)
Date: Mon, 10 Aug 2009 06:48:59 -0400
Subject: [isidorus-cvs] r112 - in trunk/src: unit_tests xml/rdf
Message-ID: <E1MaSR1-0002Ji-0C@common-lisp.net>

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)
 
 



From lgiessmann at common-lisp.net  Thu Aug 13 19:47:54 2009
From: lgiessmann at common-lisp.net (Lukas Giessmann)
Date: Thu, 13 Aug 2009 15:47:54 -0400
Subject: [isidorus-cvs] r113 - in trunk/src: . unit_tests xml/rdf
Message-ID: <E1MbgHC-0004v9-MG@common-lisp.net>

Author: lgiessmann
Date: Thu Aug 13 15:47:53 2009
New Revision: 113

Log:
rdf-importer: finalized the rdf-importer -> collections are imported as linked lists modelled as tm-associations (equal to manual created rdf-collections

Modified:
   trunk/src/constants.lisp
   trunk/src/unit_tests/rdf_importer_test.lisp
   trunk/src/xml/rdf/importer.lisp
   trunk/src/xml/rdf/rdf_core_psis.xtm
   trunk/src/xml/rdf/rdf_tools.lisp

Modified: trunk/src/constants.lisp
==============================================================================
--- trunk/src/constants.lisp	(original)
+++ trunk/src/constants.lisp	Thu Aug 13 15:47:53 2009
@@ -37,7 +37,6 @@
 	   :*rdf-rest*
 	   :*rdf2tm-object*
 	   :*rdf2tm-subject*
-	   :*rdf2tm-collection*
 	   :*rdf2tm-scope-prefix*))
 
 (in-package :constants)
@@ -95,6 +94,4 @@
 
 (defparameter *rdf2tm-subject* "http://isidorus/rdf2tm_mapping#subject")
 
-(defparameter *rdf2tm-collection* "http://isidorus/rdf2tm_mapping#collection")
-
 (defparameter *rdf2tm-scope-prefix* "http://isidorus/rdf2tm_mapping/scope#")
\ No newline at end of file

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 Aug 13 15:47:53 2009
@@ -57,7 +57,9 @@
 	   :test-poems-rdf-occurrences
 	   :test-poems-rdf-associations
 	   :test-poems-rdf-typing
-	   :test-poems-rdf-topics))
+	   :test-poems-rdf-topics
+	   :test-empty-collection
+	   :test-collection))
 
 (declaim (optimize (debug 3) (speed 0) (safety 3) (space 0) (compilation-speed 0)))
 
@@ -1034,7 +1036,7 @@
 	  (rdf-init-db :db-dir db-dir :start-revision revision-1)
 	  (rdf-importer::import-node node tm-id revision-2
 				     :document-id document-id)
-	  (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 21))
+	  (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 20))
 	  (let ((first-node (get-item-by-id "http://test-tm/first-node"
 					    :xtm-id document-id))
 		(first-type (get-item-by-id "http://test-tm/first-type"
@@ -1472,8 +1474,8 @@
 		   2))
 	    (rdf-importer::import-dom rdf-node revision-1 :tm-id tm-id
 				      :document-id document-id)
-	    (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 38))
-	    (is (= (length (elephant:get-instances-by-class 'd:AssociationC)) 10))
+	    (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 40))
+	    (is (= (length (elephant:get-instances-by-class 'd:AssociationC)) 12))
 	    (setf rdf-importer::*current-xtm* document-id)
 	    (is (= (length
 		    (intersection
@@ -1482,7 +1484,7 @@
 		     (list
 		      (d:get-item-by-id (concatenate
 					 'string
-					 constants::*rdf2tm-collection*)
+					 constants::*rdf-nil*)
 					:xtm-id rdf-importer::*rdf-core-xtm*)
 		      (d:get-item-by-psi constants::*type-instance-psi*)
 		      (dotimes (iter 9)
@@ -1515,8 +1517,9 @@
 				  constants:*type-instance-psi*))
 		  (subject (d:get-item-by-psi constants::*rdf2tm-subject*))
 		  (object (d:get-item-by-psi constants::*rdf2tm-object*))
-		  (collection (d:get-item-by-id
-			       constants::*rdf2tm-collection*)))
+		  (rdf-first (d:get-item-by-psi constants:*rdf-first*))
+		  (rdf-rest (d:get-item-by-psi constants:*rdf-rest*))
+		  (rdf-nil (d:get-item-by-psi constants:*rdf-nil*)))
 	      (is (= (length (d:psis first-node)) 1))
 	      (is (string= (d:uri (first (d:psis first-node)))
 			   "http://test-tm/first-node"))
@@ -1560,6 +1563,15 @@
 	      (is (= (length (d:psis arc8)) 1))
 	      (is (string= (d:uri (first (d:psis arc8)))
 			   "http://test/arcs/arc8"))
+	      (is (= (length (d:psis rdf-first)) 1))
+	      (is (string= (d:uri (first (d:psis rdf-first)))
+			   constants:*rdf-first*))
+	      (is (= (length (d:psis rdf-rest)) 1))
+	      (is (string= (d:uri (first (d:psis rdf-rest)))
+			   constants:*rdf-rest*))
+	      (is (= (length (d:psis rdf-nil)) 1))
+	      (is (string= (d:uri (first (d:psis rdf-nil)))
+			   constants:*rdf-nil*))
 	      (is (= (length (elephant:get-instances-by-class 'd:OccurrenceC))
 		     1))
 	      (is (string= (d:charvalue (first (elephant:get-instances-by-class
@@ -1629,30 +1641,84 @@
 				     (eql (d:instance-of (d:parent x)) arc4)))
 			    (d:player-in-roles uuid-1))))))))
 		  (is-true col-1)
-		  (is (= (length (d:player-in-roles col-1)) 2))
+		  (is (= (length (d:player-in-roles col-1)) 3))
 		  (is-true (find-if
 			    #'(lambda(x)
 				(and (eql (d:instance-of x) subject)
 				     (eql (d:instance-of (d:parent x)) 
-					  collection)))
+					  rdf-first)))
 			    (d:player-in-roles col-1)))
-		  (let ((col-assoc
-			 (d:parent
-			  (find-if
+		  (is-true (find-if
 			    #'(lambda(x)
 				(and (eql (d:instance-of x) subject)
 				     (eql (d:instance-of (d:parent x)) 
-					  collection)))
-			    (d:player-in-roles col-1)))))
-		    (is-true col-assoc)
-		    (is (= (length (d:roles col-assoc)) 3))
-		    (is (= (count-if
+					  rdf-rest)))
+			    (d:player-in-roles col-1)))
+		  (is-true (find-if
+			    #'(lambda(x)
+				(and (eql (d:instance-of x) object)
+				     (eql (d:instance-of (d:parent x)) 
+					  arc4)))
+			    (d:player-in-roles col-1)))
+		  (is (= (length (d:player-in-roles item-1)) 1))
+		  (is-true (find-if
 			    #'(lambda(x)
 				(and (eql (d:instance-of x) object)
-				     (or (eql (d:player x) item-1)
-					 (eql (d:player x) item-2))))
-			    (d:roles col-assoc))
-			   2))))
+				     (eql (d:instance-of (d:parent x)) 
+					  rdf-first)))
+			    (d:player-in-roles item-1)))
+		  (let ((col-2
+			 (let ((role
+				(find-if
+				 #'(lambda(x)
+				     (and (eql (d:instance-of x) subject)
+					  (eql (d:instance-of (d:parent x)) 
+					       rdf-rest)))
+				 (d:player-in-roles col-1))))
+			   (is (= (length (d:roles (d:parent role))) 2))
+			   (let ((other-role
+				  (find-if #'(lambda(x)
+					       (and (not (eql x role))
+						    (eql (d:instance-of x)
+							 object)))
+					   (d:roles (d:parent role)))))
+			     (d:player other-role)))))
+		    (is-true col-2)
+		    (is (= (length (d:psis col-2)) 0))
+		    (is (= (length (d:player-in-roles col-2)) 3))
+		    (is-true (find-if
+			      #'(lambda(x)
+				  (and (eql (d:instance-of x) subject)
+				       (eql (d:instance-of (d:parent x))
+					    rdf-first)))
+			      (d:player-in-roles col-2)))
+		    (is-true (find-if
+			      #'(lambda(x)
+				  (and (eql (d:instance-of x) subject)
+				       (eql (d:instance-of (d:parent x))
+					    rdf-rest)))
+			      (d:player-in-roles col-2)))
+		    (let ((col-3
+			   (let ((role
+				  (find-if
+				   #'(lambda(x)
+				       (and (eql (d:instance-of x) subject)
+					    (eql (d:instance-of (d:parent x))
+						 rdf-rest)))
+				   (d:player-in-roles col-2))))
+
+			     (is (= (length (d:roles (d:parent role))) 2))
+			     (let ((other-role
+				    (find-if
+				     #'(lambda(x)
+					 (not (eql x role)))
+				     (d:roles (d:parent role)))))
+			       (d:player other-role)))))
+		      (is-true col-3)
+		      (is (= (length (d:psis col-3)) 1))
+		      (is (string= (d:uri (first (d:psis col-3)))
+				   constants:*rdf-nil*))
+		      (is (= (length (d:player-in-roles col-3)) 2)))))
 		(is (= (length (d:player-in-roles item-1)) 1))
 		(is (= (length (d:player-in-roles item-2)) 2))
 		(is-true (find-if
@@ -1689,12 +1755,13 @@
 			 4))
 		  (is (= (length (d:player-in-roles fourth-node)) 1))
 		  (is (= (length (d:player-in-roles fifth-node)) 1))
+		  (format t "--->")
 		  (let ((col-2
 			 (d:player
 			  (find-if
 			   #'(lambda(y)
 			       (and (eql (d:instance-of y) object)
-				    (= 0 (length (d:psis (d:player y))))))
+				    (= 1 (length (d:psis (d:player y))))))
 			   (d:roles
 			    (d:parent
 			     (find-if
@@ -1702,24 +1769,11 @@
 				  (and (eql (d:instance-of x) subject)
 				       (eql (d:instance-of (d:parent x)) arc8)))
 			      (d:player-in-roles uuid-2))))))))
+		    (is (= (length (d:psis col-2)) 1))
+		    (is (string= constants:*rdf-nil*
+				 (d:uri (first (d:psis col-2)))))
 		    (is-true col-2)
-		    (is (= (length (d:player-in-roles col-2)) 2))
-		    (is-true (find-if
-			      #'(lambda(x)
-				  (and (eql (d:instance-of x) subject)
-				       (eql (d:instance-of (d:parent x)) 
-					    collection)))
-			      (d:player-in-roles col-2)))
-		    (let ((col-assoc
-			   (d:parent
-			    (find-if
-			     #'(lambda(x)
-				 (and (eql (d:instance-of x) subject)
-				      (eql (d:instance-of (d:parent x)) 
-					   collection)))
-			     (d:player-in-roles col-2)))))
-		      (is-true col-assoc)
-		      (is (= (length (d:roles col-assoc)) 1))))))))))
+		    (is (= (length (d:player-in-roles col-2)) 2)))))))))
   (elephant:close-store))
 
 
@@ -1742,7 +1796,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) 66))
+      (is (= (length topics) 65))
       (is (= (length occs) 23))
       (is (= (length assocs) 30))
       (is-true de)
@@ -2350,9 +2404,7 @@
 	  (zauberlehrling "http://some.where/poem/Der_Zauberlehrling")
 	  (prometheus "http://some.where/poem/Prometheus")
 	  (erlkoenig "http://some.where/ballad/Der_Erlkoenig")
-	  (country "http://some.where/types/Country")
-	  
-	  )
+	  (country "http://some.where/types/Country"))
       (is (= (count-if
 	      #'(lambda(x)
 		  (and (eql (d:instance-of x) supertype-subtype)
@@ -2708,6 +2760,227 @@
 	       6))))))
 
 
+(test test-empty-collection
+  "Tests importing of empty collections."
+  (let ((db-dir "data_base")
+	(tm-id "http://test-tm/")
+	(revision-1 100)
+	(document-id "doc-id")
+	(doc-1
+	 (concatenate 'string "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" "
+		      "xmlns:arcs=\"http://test/arcs/\">"
+		      " <rdf:Description rdf:about=\"first-node\">"
+		      "  <arcs:arc rdf:parseType=\"Collection\" />"
+		      " </rdf:Description>"
+		      "</rdf:RDF>")))
+    (let ((rdf-node (elt (dom:child-nodes 
+			  (cxml:parse doc-1 (cxml-dom:make-dom-builder)))
+			 0)))
+      (is-true rdf-node)
+      (rdf-init-db :db-dir db-dir :start-revision revision-1)
+      (rdf-importer::import-dom rdf-node revision-1 :tm-id tm-id
+				:document-id document-id)
+      (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 21))
+      (is (= (length (elephant:get-instances-by-class 'd:AssociationC)) 1))
+      (is (= (length (elephant:get-instances-by-class 'd:OccurrenceC)) 0))
+      (is (= (length (elephant:get-instances-by-class 'd:NameC)) 0))
+      (let ((first-node (d:get-item-by-id "http://test-tm/first-node"
+					  :xtm-id document-id))
+	    (arc (d:get-item-by-id "http://test/arcs/arc"
+				   :xtm-id document-id))
+	    (rdf-nil (d:get-item-by-id constants:*rdf-nil*
+				       :xtm-id document-id))
+	    (subject (d:get-item-by-id constants:*rdf2tm-subject*))
+	    (object (d:get-item-by-id constants:*rdf2tm-object*)))
+	(is-true subject)
+	(is-true object)
+	(is-true first-node)
+	(is (= (length (d:psis first-node)) 1))
+	(is (string= (d:uri (first (d:psis first-node)))
+		     "http://test-tm/first-node"))
+	(is-true arc)
+	(is (= (length (d:psis arc)) 1))
+	(is (string= (d:uri (first (d:psis arc)))
+		     "http://test/arcs/arc"))
+	(is-true rdf-nil)
+	(is (= (length (d:psis rdf-nil)) 1))
+	(is (string= (d:uri (first (d:psis rdf-nil))) constants:*rdf-nil*))
+	(is (= (length (d:player-in-roles first-node)) 1))
+	(is (= (length (d:player-in-roles arc)) 0))
+	(is (= (length (d:player-in-roles rdf-nil)) 1))
+	(is-true (find-if
+		  #'(lambda(x)
+		      (and (eql (d:instance-of x) subject)
+			   (eql (d:instance-of (d:parent x)) arc)))
+		  (d:player-in-roles first-node)))
+	(is-true (find-if
+		  #'(lambda(x)
+		      (and (eql (d:instance-of x) object)
+			   (eql (d:instance-of (d:parent x)) arc)))
+		  (d:player-in-roles rdf-nil)))))))
+
+
+(test test-collection
+  "Tests importing of non-empty collections."
+  (let ((db-dir "data_base")
+	(tm-id "http://test-tm/")
+	(revision-1 100)
+	(document-id "doc-id")
+	(doc-1
+	 (concatenate 'string "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" "
+		      "xmlns:arcs=\"http://test/arcs/\">"
+		      " <rdf:Description rdf:about=\"first-node\">"
+		      "  <arcs:arc rdf:parseType=\"Collection\">"
+		      "   <rdf:Description rdf:about=\"item-1\"/>"
+		      "   <arcs:Node rdf:about=\"item-2\"/>"
+		      "  </arcs:arc>"
+		      " </rdf:Description>"
+		      "</rdf:RDF>")))
+    (let ((rdf-node (elt (dom:child-nodes 
+			  (cxml:parse doc-1 (cxml-dom:make-dom-builder)))
+			 0)))
+      (is-true rdf-node)
+      (rdf-init-db :db-dir db-dir :start-revision revision-1)
+      (rdf-importer::import-dom rdf-node revision-1 :tm-id tm-id
+				:document-id document-id)
+      (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 28))
+      (is (= (length (elephant:get-instances-by-class 'd:AssociationC)) 6))
+      (is (= (length (elephant:get-instances-by-class 'd:OccurrenceC)) 0))
+      (is (= (length (elephant:get-instances-by-class 'd:NameC)) 0))
+      (let ((first-node (d:get-item-by-id "http://test-tm/first-node"
+					  :xtm-id document-id))
+	    (arc (d:get-item-by-id "http://test/arcs/arc"
+				   :xtm-id document-id))
+	    (item-1 (d:get-item-by-id "http://test-tm/item-1"
+				      :xtm-id document-id))
+	    (item-2 (d:get-item-by-id "http://test-tm/item-2"
+				      :xtm-id document-id))
+	    (node (d:get-item-by-id "http://test/arcs/Node"
+				    :xtm-id document-id))
+	    (rdf-first (d:get-item-by-id constants:*rdf-first*
+					 :xtm-id document-id))
+	    (rdf-rest (d:get-item-by-id constants:*rdf-rest*
+					:xtm-id document-id))
+	    (rdf-nil (d:get-item-by-id constants:*rdf-nil*
+				       :xtm-id document-id))
+	    (subject (d:get-item-by-id constants:*rdf2tm-subject*
+				       :xtm-id document-id))
+	    (object (d:get-item-by-id constants:*rdf2tm-object*
+				      :xtm-id document-id))
+	    (instance (d:get-item-by-psi constants:*instance-psi*))
+	    (type (d:get-item-by-psi constants:*type-psi*))
+	    (type-instance (d:get-item-by-psi constants:*type-instance-psi*)))
+	(is-true first-node)
+	(is (= (length (d:psis first-node)) 1))
+	(is (string= (d:uri (first (d:psis first-node)))
+		     "http://test-tm/first-node"))
+	(is (= (length (d:player-in-roles first-node)) 1))
+	(is-true arc)
+	(is (= (length (d:psis arc)) 1))
+	(is (string= (d:uri (first (d:psis arc)))
+		     "http://test/arcs/arc"))
+	(is (= (length (d:player-in-roles arc)) 0))
+	(is-true item-1)
+	(is (= (length (d:psis item-1)) 1))
+	(is (string= (d:uri (first (d:psis item-1)))
+		     "http://test-tm/item-1"))
+	(is (= (length (d:player-in-roles item-1)) 1))
+	(is-true item-2)
+	(is (= (length (d:psis item-2)) 1))
+	(is (string= (d:uri (first (d:psis item-2)))
+		     "http://test-tm/item-2"))
+	(is (= (length (d:player-in-roles item-2)) 2))
+	(is-true node)
+	(is (= (length (d:psis node)) 1))
+	(is (string= (d:uri (first (d:psis node)))
+		     "http://test/arcs/Node"))
+	(is (= (length (d:player-in-roles node)) 1))
+	(is-true rdf-first)
+	(is-true rdf-rest)
+	(is-true rdf-nil)
+	(is (= (length (d:player-in-roles rdf-nil)) 1))
+	(is-true subject)
+	(is-true object)
+	(let ((uuid-1
+	       (d:player
+		(find-if 
+		 #'(lambda(x)
+		     (not (eql x (first (d:player-in-roles first-node)))))
+		 (d:roles (d:parent (first (d:player-in-roles first-node)))))))
+	      (uuid-2
+	       (d:player
+		(find-if 
+		 #'(lambda(x)
+		     (not (eql x (first (d:player-in-roles rdf-nil)))))
+		 (d:roles (d:parent (first (d:player-in-roles rdf-nil))))))))
+	  (is-true uuid-1)
+	  (is (= (length (d:psis uuid-1)) 0))
+	  (is (= (length (d:player-in-roles uuid-1)) 3))
+	  (is-true uuid-2)
+	  (is (= (length (d:psis uuid-2)) 0))
+	  (is (= (length (d:player-in-roles uuid-2)) 3))
+	  (is-true (find-if
+		    #'(lambda(x)
+			(and (eql (d:instance-of x) subject)
+			     (eql (d:instance-of (d:parent x)) arc)))
+		    (d:player-in-roles first-node)))
+	  (is-true (find-if
+		    #'(lambda(x)
+			(and (eql (d:instance-of x) object)
+			     (eql (d:instance-of (d:parent x)) arc)))
+		    (d:player-in-roles uuid-1)))
+	  (is-true (find-if
+		    #'(lambda(x)
+			(and (eql (d:instance-of x) subject)
+			     (eql (d:instance-of (d:parent x)) rdf-first)))
+		    (d:player-in-roles uuid-1)))
+	  (is-true (find-if
+		    #'(lambda(x)
+			(and (eql (d:instance-of x) subject)
+			     (eql (d:instance-of (d:parent x)) rdf-rest)))
+		    (d:player-in-roles uuid-1)))
+	  (is-true (find-if
+		    #'(lambda(x)
+			(and (eql (d:instance-of x) object)
+			     (eql (d:instance-of (d:parent x)) rdf-first)))
+		    (d:player-in-roles item-1)))
+	  (is-true (find-if
+		    #'(lambda(x)
+			(and (eql (d:instance-of x) object)
+			     (eql (d:instance-of (d:parent x)) rdf-rest)))
+		    (d:player-in-roles uuid-2)))
+	  (is-true (find-if
+		    #'(lambda(x)
+			(and (eql (d:instance-of x) subject)
+			     (eql (d:instance-of (d:parent x)) rdf-first)))
+		    (d:player-in-roles uuid-2)))
+	  (is-true (find-if
+		    #'(lambda(x)
+			(and (eql (d:instance-of x) subject)
+			     (eql (d:instance-of (d:parent x)) rdf-rest)))
+		    (d:player-in-roles uuid-2)))
+	  (is-true (find-if
+		    #'(lambda(x)
+			(and (eql (d:instance-of x) object)
+			     (eql (d:instance-of (d:parent x)) rdf-rest)))
+		    (d:player-in-roles rdf-nil)))
+	  (is-true (find-if
+		    #'(lambda(x)
+			(and (eql (d:instance-of x) object)
+			     (eql (d:instance-of (d:parent x)) rdf-first)))
+		    (d:player-in-roles item-2)))
+	  (is-true (find-if
+		    #'(lambda(x)
+			(and (eql (d:instance-of x) instance)
+			     (eql (d:instance-of (d:parent x)) type-instance)))
+		    (d:player-in-roles item-2)))
+	  (is-true (find-if
+		    #'(lambda(x)
+			(and (eql (d:instance-of x) type)
+			     (eql (d:instance-of (d:parent x)) type-instance)))
+		    (d:player-in-roles node))))))))
+
+
 (defun run-rdf-importer-tests()
   (when elephant:*store-controller*
     (elephant:close-store))
@@ -2726,4 +2999,6 @@
   (it.bese.fiveam:run! 'test-poems-rdf-occurrences)
   (it.bese.fiveam:run! 'test-poems-rdf-associations)
   (it.bese.fiveam:run! 'test-poems-rdf-typing)
-  (it.bese.fiveam:run! 'test-poems-rdf-topics))
\ No newline at end of file
+  (it.bese.fiveam:run! 'test-poems-rdf-topics)
+  (it.bese.fiveam:run! 'test-empty-collection)
+  (it.bese.fiveam:run! 'test-collection))
\ 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 Aug 13 15:47:53 2009
@@ -101,8 +101,6 @@
   (format t ">> import-node: ~a <<~%" (dom:node-name elem)) ;TODO: remove
   (tm-id-p tm-id "import-node")
   (parse-node elem)
-  ;TODO: handle Collections that are made manually without
-  ;      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)))
     (let ((about (get-absolute-attribute elem tm-id xml-base "about"))	   
@@ -158,76 +156,123 @@
   (let ((fn-xml-lang (get-xml-lang elem :old-lang xml-lang))
 	(fn-xml-base (get-xml-base elem :old-base xml-base))
 	(UUID (get-ns-attribute elem "UUID" :ns-uri *rdf2tm-ns*))
-	(parseType (get-ns-attribute elem "parseType")))
-    (when (or (not parseType)
-	      (and parseType
-		   (string/= parseType "Collection")))
-      (when UUID
-	(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)))
-	    (let ((literals (append (get-literals-of-property 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))
-		  (types (remove-if
-			  #'null
-			  (append
-			   (get-types-of-node-content elem tm-id fn-xml-base)
-			   (when (get-ns-attribute elem "type")
-			     (list :ID nil
-				   :topicid (get-ns-attribute elem "type")
-				   :psi (get-ns-attribute elem "type"))))))
-		  (super-classes
-		   (get-super-classes-of-node-content elem tm-id xml-base)))
-	      (make-literals this literals tm-id start-revision
-			     :document-id document-id)
-	      (make-associations this associations xml-importer::tm
-				 start-revision :document-id document-id)
-	      (make-types this types xml-importer::tm start-revision
-			  :document-id document-id)
-	      (make-super-classes this super-classes xml-importer::tm
-				  start-revision :document-id document-id))))))
-    (make-recursion-from-arc elem tm-id start-revision
-			     :document-id document-id
-			     :xml-base xml-base :xml-lang xml-lang)))
+	(parseType (get-ns-attribute elem "parseType"))
+	(content (child-nodes-or-text elem :trim t)))
+    (with-tm (start-revision document-id tm-id)
+      (if (and (string= parseType "Collection")
+	       (= (length content) 0))
+	    (make-topic-stub *rdf-nil* nil nil nil start-revision
+			     xml-importer::tm :document-id document-id)
+	  (let ((this-topic
+		 (when (or (not parseType)
+			   (and parseType
+				(string/= parseType "Collection")))
+		   (when UUID
+		     (parse-properties-of-node elem UUID)
+		     (let ((this
+			    (get-item-by-id UUID :xtm-id document-id
+					    :revision start-revision)))
+		       (let ((literals
+			      (append (get-literals-of-property
+				       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))
+			     (types
+			      (remove-if
+			       #'null
+			       (append
+				(get-types-of-node-content elem tm-id fn-xml-base)
+				(when (get-ns-attribute elem "type")
+				  (list :ID nil
+					:topicid (get-ns-attribute elem "type")
+					:psi (get-ns-attribute elem "type"))))))
+			     (super-classes
+			      (get-super-classes-of-node-content
+			       elem tm-id xml-base)))
+			 (make-literals this literals tm-id start-revision
+					:document-id document-id)
+			 (make-associations this associations xml-importer::tm
+					    start-revision :document-id document-id)
+			 (make-types this types xml-importer::tm start-revision
+				     :document-id document-id)
+			 (make-super-classes
+			  this super-classes xml-importer::tm
+			  start-revision :document-id document-id))
+		       this)))))
+	    (make-recursion-from-arc elem tm-id start-revision
+				     :document-id document-id
+				     :xml-base xml-base :xml-lang xml-lang)
+	    this-topic)))))
 
 
-(defun make-collection (elem owner-top tm-id start-revision
+(defun make-collection (elem tm-id start-revision
 			&key (document-id *document-id*)
 			(xml-base nil) (xml-lang nil))
-  "Creates a TM association with a subject role containing the collection
-   entry point and as many roles of the type 'object' as items exists."
-  (declare (d:TopicC owner-top))
+  "Creates a collection structure of a node that contains
+   parseType='Collection."
+  (declare (dom:element elem))
   (with-tm (start-revision document-id tm-id)
     (let ((fn-xml-base (get-xml-base elem :old-base xml-base))
 	  (fn-xml-lang (get-xml-lang elem :old-lang xml-lang))
-	  (subject (make-topic-stub *rdf2tm-subject* nil nil nil start-revision
-				    xml-importer::tm :document-id document-id))
-	  (object (make-topic-stub *rdf2tm-object* nil nil nil start-revision
-				   xml-importer::tm :document-id document-id)))
-      (let ((association-type (make-topic-stub *rdf2tm-collection* nil nil nil
-					       start-revision xml-importer::tm
-					       :document-id document-id))
-	    (roles
-	     (append
-	      (loop for item across (child-nodes-or-text elem :trim t)
-		 collect (let ((item-top (import-node item tm-id start-revision
-						      :document-id document-id
-						      :xml-base fn-xml-base
-						      :xml-lang fn-xml-lang)))
-			   (list :player item-top
-				 :instance-of object)))
-	      (list (list :player owner-top
-			  :instance-of subject)))))
-	(add-to-topicmap
-	 xml-importer::tm
-	 (make-construct 'd:AssociationC
-			 :start-revision start-revision
-			 :instance-of association-type
-			 :roles roles))))))
+	  (UUID (get-ns-attribute elem "UUID" :ns-uri *rdf2tm-ns*)))
+      (let ((this (make-topic-stub nil nil nil UUID start-revision
+				   xml-importer::tm
+				   :document-id document-id))
+	    (items (loop for item across (child-nodes-or-text elem :trim t)
+		      collect (import-node item tm-id start-revision
+					   :document-id document-id
+					   :xml-base fn-xml-base
+					   :xml-lang fn-xml-lang))))
+	(let ((last-blank-node this))
+	  (dotimes (index (length items))
+	    (let ((is-end
+		   (if (= index (- (length items) 1))
+		       t
+		       nil)))
+	      (let ((new-blank-node
+		     (make-collection-association
+		      last-blank-node (elt items index) tm-id  start-revision
+		      :is-end is-end :document-id document-id)))
+		(setf last-blank-node new-blank-node)))))))))
+
+
+(defun make-collection-association (current-blank-node first-object tm-id
+				    start-revision &key (is-end nil)
+				    (document-id *document-id*))
+  "Creates a 'first'-association between the current-blank-node and the
+   first-object. If is-end is set to true another association between
+   current-blank-node and the topic rdf:nil is created. Otherwise this
+   associaiton is made from the current-blank-node to a new created blank
+   node."
+  (declare (d:TopicC current-blank-node first-object))
+  (with-tm (start-revision document-id tm-id)
+    (let ((first-arc
+	   (make-topic-stub *rdf-first* nil nil nil start-revision 
+			    xml-importer::tm :document-id document-id))
+	  (rest-arc
+	   (make-topic-stub *rdf-rest* nil nil nil start-revision
+			    xml-importer::tm :document-id document-id)))
+      (make-association-with-nodes current-blank-node first-object first-arc
+				   xml-importer::tm start-revision
+				   :document-id document-id)
+      (if is-end
+	  (let ((rdf-nil (make-topic-stub *rdf-nil* nil nil nil
+					  start-revision xml-importer::tm
+					  :document-id document-id)))
+	    (make-association-with-nodes
+	     current-blank-node rdf-nil rest-arc xml-importer::tm
+	     start-revision :document-id document-id)
+	    nil)
+	  (let ((new-blank-node (make-topic-stub
+				 nil nil nil (get-uuid) start-revision
+				 xml-importer::tm :document-id document-id)))
+	    (make-association-with-nodes
+	     current-blank-node new-blank-node rest-arc xml-importer::tm
+	     start-revision :document-id document-id)
+	    new-blank-node)))))
 
 
 (defun make-literals (owner-top literals tm-id start-revision
@@ -801,10 +846,15 @@
 		   (not (and (string= prop-name "subClassOf")
 			     (string= prop-ns *rdfs-ns*)))))
        collect (let ((prop-xml-base (get-xml-base property
-						  :old-base fn-xml-base)))
+						  :old-base fn-xml-base))
+		     (content (child-nodes-or-text property :trim t))
+		     (parseType (get-ns-attribute property "parseType")))
 		 (let ((resource
-			(get-absolute-attribute property tm-id
-						fn-xml-base "resource"))
+			(if (and (string= parseType "Collection")
+				 (= (length content) 0))
+			    *rdf-nil*
+			    (get-absolute-attribute property tm-id
+						    fn-xml-base "resource")))
 		       (nodeID (get-ns-attribute property "nodeID"))
 		       (UUID (get-ns-attribute property "UUID"
 					       :ns-uri *rdf2tm-ns*))
@@ -813,7 +863,7 @@
 		       (full-name (get-type-of-node-name property)))
 		   (if (or nodeID resource UUID)
 		       (list :type full-name
-			     :topicid (or nodeID resource UUID)
+			     :topicid (or resource nodeID UUID)
 			     :psi resource
 			     :ID ID)
 		       (let ((refs (get-node-refs
@@ -851,8 +901,7 @@
   (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))
-	(parseType (get-ns-attribute arc "parseType"))
-	(UUID (get-ns-attribute arc "UUID" :ns-uri *rdf2tm-ns*)))
+	(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"))
 	  (resource (get-absolute-attribute arc tm-id xml-base "resource"))
@@ -860,32 +909,27 @@
 	  (literals (get-literals-of-property arc xml-lang)))
       (if (and parseType
 	       (string= parseType "Collection"))
-	  (let ((this
-		 (with-tm (start-revision document-id tm-id)
-		   (make-topic-stub nil nil nil UUID start-revision
-				    xml-importer::tm
-				    :document-id document-id))))
-	    (make-collection arc this tm-id start-revision
-			     :document-id document-id
-			     :xml-base xml-base
-			     :xml-lang xml-lang))
+	  (make-collection arc tm-id start-revision
+			   :document-id document-id
+			   :xml-base xml-base
+			   :xml-lang xml-lang)
 	  (if (or datatype resource nodeID
 		  (and parseType
 		       (string= parseType "Literal"))
 		  (and content
 		       (stringp content)))
-	      t;; do nothing current elem is a literal node that has been
-	       ;; already imported as an occurrence
+	      nil;; do nothing current elem is a literal node that has been
+	         ;; already imported as an occurrence
 	      (if (or type literals
 		      (and parseType
 			   (string= parseType "Resource")))
 		  (loop for item across content
-		     do (import-arc item tm-id start-revision
-				    :document-id document-id
-				    :xml-base fn-xml-base
-				    :xml-lang fn-xml-lang))
+		     collect (import-arc item tm-id start-revision
+					 :document-id document-id
+					 :xml-base fn-xml-base
+					 :xml-lang fn-xml-lang))
 		  (loop for item across content
-		     do (import-node item tm-id start-revision
-				     :document-id document-id
-				     :xml-base xml-base
-				     :xml-lang xml-lang))))))))
+		     collect (import-node item tm-id start-revision
+					  :document-id document-id
+					  :xml-base xml-base
+					  :xml-lang xml-lang))))))))
\ No newline at end of file

Modified: trunk/src/xml/rdf/rdf_core_psis.xtm
==============================================================================
--- trunk/src/xml/rdf/rdf_core_psis.xtm	(original)
+++ trunk/src/xml/rdf/rdf_core_psis.xtm	Thu Aug 13 15:47:53 2009
@@ -23,13 +23,6 @@
       <value>object</value>
     </name>
   </topic>
-  
-  <topic id="collection">
-    <subjectIdentifier href="http://isidorus/rdf2tm_mapping#collection"/>
-    <name>
-      <value>object</value>
-    </name>
-  </topic>
 
   <topic id="supertype-subtype">
     <subjectIdentifier href="http://psi.topicmaps.org/iso13250/model/supertype-subtype"/>

Modified: trunk/src/xml/rdf/rdf_tools.lisp
==============================================================================
--- trunk/src/xml/rdf/rdf_tools.lisp	(original)
+++ trunk/src/xml/rdf/rdf_tools.lisp	Thu Aug 13 15:47:53 2009
@@ -31,7 +31,6 @@
 		*rdf-nil*
 		*rdf-first*
 		*rdf-rest*
-		*rdf2tm-collection*
 		*rdf2tm-scope-prefix*)
   (:import-from :xml-constants
 		*rdf_core_psis.xtm*)



From lgiessmann at common-lisp.net  Thu Aug 13 21:19:32 2009
From: lgiessmann at common-lisp.net (Lukas Giessmann)
Date: Thu, 13 Aug 2009 17:19:32 -0400
Subject: [isidorus-cvs] r114 - in trunk/src: unit_tests xml/xtm
Message-ID: <E1Mbhhs-00035N-4S@common-lisp.net>

Author: lgiessmann
Date: Thu Aug 13 17:19:31 2009
New Revision: 114

Log:
rdf-importer: fixed a bug with xml-base

Modified:
   trunk/src/unit_tests/rdf_importer_test.lisp
   trunk/src/xml/xtm/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 Aug 13 17:19:31 2009
@@ -59,7 +59,8 @@
 	   :test-poems-rdf-typing
 	   :test-poems-rdf-topics
 	   :test-empty-collection
-	   :test-collection))
+	   :test-collection
+	   :test-xml-base))
 
 (declaim (optimize (debug 3) (speed 0) (safety 3) (space 0) (compilation-speed 0)))
 
@@ -1755,7 +1756,6 @@
 			 4))
 		  (is (= (length (d:player-in-roles fourth-node)) 1))
 		  (is (= (length (d:player-in-roles fifth-node)) 1))
-		  (format t "--->")
 		  (let ((col-2
 			 (d:player
 			  (find-if
@@ -2981,6 +2981,73 @@
 		    (d:player-in-roles node))))))))
 
 
+(test test-xml-base
+  "Tests the function get-xml-base."
+  (let ((doc-1
+	 (concatenate 'string "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" "
+		      "xmlns:arcs=\"http://test/arcs/\">"
+		      " <rdf:Description xml:base=\"http://base-1\"/>"
+		      " <rdf:Description xml:base=\"http://base-2#\"/>"
+		      " <rdf:Description xml:base=\"http://base-3/\"/>"
+		      "</rdf:RDF>")))
+    (let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder))))
+      (let ((rdf-node (elt (dom:child-nodes dom-1) 0)))
+	(let ((n-1 (elt (rdf-importer::child-nodes-or-text rdf-node
+							   :trim t) 0))
+	      (n-2 (elt (rdf-importer::child-nodes-or-text rdf-node
+							   :trim t) 1))
+	      (n-3 (elt (rdf-importer::child-nodes-or-text rdf-node
+							   :trim t) 2)))
+	  (is (string= (xml-tools::concatenate-uri
+			(xml-tools:get-xml-base n-1)
+			"test")
+		       "http://base-1/test"))
+	  (is (string= (xml-tools::concatenate-uri
+			(xml-tools:get-xml-base n-1)
+			"/test")
+		       "http://base-1/test"))
+	  (is (string= (xml-tools::concatenate-uri
+			(xml-tools:get-xml-base n-1)
+			"#test")
+		       "http://base-1#test"))
+	  (is (string= (xml-tools::concatenate-uri
+			(xml-tools:get-xml-base n-2)
+			"test")
+		       "http://base-2#test"))
+	  (is (string= (xml-tools::concatenate-uri
+			(xml-tools:get-xml-base n-2)
+			"#test")
+		       "http://base-2#test"))
+	  (is (string= (xml-tools::concatenate-uri
+			(xml-tools:get-xml-base n-2)
+			"/test")
+		       "http://base-2/test"))
+	  (is (string= (xml-tools::concatenate-uri
+			(xml-tools:get-xml-base n-2)
+			"/t/est")
+		       "http://base-2/t/est"))
+	  (is (string= (xml-tools::concatenate-uri
+			(xml-tools:get-xml-base n-2)
+			"t/est")
+		       "http://base-2/t/est"))
+	  (signals error (xml-tools::concatenate-uri
+			  (xml-tools:get-xml-base n-2) ""))
+	  (signals error (xml-tools::concatenate-uri
+			  "" "test"))
+	  (is (string= (xml-tools::concatenate-uri
+			(xml-tools:get-xml-base n-3)
+			"test")
+		       "http://base-3/test"))
+	  (is (string= (xml-tools::concatenate-uri
+			(xml-tools:get-xml-base n-3)
+			"#test")
+		       "http://base-3/#test"))
+	  (is (string= (xml-tools::concatenate-uri
+			(xml-tools:get-xml-base n-3)
+			"/test")
+		       "http://base-3/test")))))))
+
+
 (defun run-rdf-importer-tests()
   (when elephant:*store-controller*
     (elephant:close-store))
@@ -3001,4 +3068,5 @@
   (it.bese.fiveam:run! 'test-poems-rdf-typing)
   (it.bese.fiveam:run! 'test-poems-rdf-topics)
   (it.bese.fiveam:run! 'test-empty-collection)
-  (it.bese.fiveam:run! 'test-collection))
\ No newline at end of file
+  (it.bese.fiveam:run! 'test-collection)
+  (it.bese.fiveam:run! 'test-xml-base))
\ No newline at end of file

Modified: trunk/src/xml/xtm/tools.lisp
==============================================================================
--- trunk/src/xml/xtm/tools.lisp	(original)
+++ trunk/src/xml/xtm/tools.lisp	Thu Aug 13 17:19:31 2009
@@ -44,27 +44,38 @@
   "Returns a string conctenated of the absolut namespace an the given value
    separated by either '#' or '/'."
   (declare (string absolute-ns value))
-  (unless (or (> (length absolute-ns) 0)
-	      (> (length value) 0))
+  (unless (and (> (length absolute-ns) 0)
+	       (> (length value) 0))
     (error "From concatenate-uri(): absolute-ns and value must be of length > 0"))
   (unless (absolute-uri-p absolute-ns)
     (error "From concatenate-uri(): absolute-ns has to be an absolute URI: ~a" absolute-ns))
   (let ((last-char
-	 (elt absolute-ns (- (length absolute-ns) 1))))
+	 (elt absolute-ns (- (length absolute-ns) 1)))
+	(first-char
+	 (elt value 0)))
     (let ((separator
 	   (cond
-	     ((eql last-char #\#)
-	      "#")
-	     ((eql last-char #\/)
-	      "/")
+	     ((or (eql first-char #\#)
+		  (eql first-char #\/))
+	      "")
+	     ((or (eql last-char #\#)
+		  (eql last-char #\/))
+	      "")
 	     (t
-	      "#")))
-	  (prep-ns
-	   (if (or (eql last-char #\#)
-		   (eql last-char #\/))
-	       (subseq absolute-ns 0 (- (length absolute-ns) 1))
-	       absolute-ns)))
-      (concatenate 'string prep-ns separator value))))
+	      "/"))))
+      (let ((prep-ns
+	     (if (and (eql last-char first-char)
+		      (or (eql last-char #\#)
+			  (eql last-char #\/)))
+		 (subseq absolute-ns 0 (- (length absolute-ns) 1))
+		 (if (and (eql last-char #\#)
+			  (find #\/ value))
+		     (progn
+		       (when (not (eql first-char #\/))
+			 (setf separator "/"))
+		       (subseq absolute-ns 0 (- (length absolute-ns) 1)))
+		     absolute-ns))))
+	(concatenate 'string prep-ns separator value)))))
 
 
 (defun absolutize-id (id xml-base tm-id)
@@ -142,9 +153,11 @@
   (declare (dom:element elem))
   (let ((new-base
 	 (let ((inner-base
-		(if (find #\# (get-ns-attribute elem "base" :ns-uri *xml-ns*))
+		(if (> (count #\# (get-ns-attribute elem "base"
+						    :ns-uri *xml-ns*))
+		       1)
 		    (error "From get-xml-base(): the base-uri ~a is not valid"
-			   (get-ns-attribute elem *xml-ns* "base"))
+			   (get-ns-attribute elem "base" :ns-uri *xml-ns*))
 		    (when (get-ns-attribute elem "base" :ns-uri *xml-ns*)
 		      (string-trim '(#\Space #\Tab #\Newline)
 				   (get-ns-attribute elem "base" :ns-uri *xml-ns*))))))
@@ -152,7 +165,6 @@
 		    (eql (elt inner-base 0) #\/))
 	       (subseq inner-base 1 (length inner-base))
 	       inner-base))))
-
     (if (or (absolute-uri-p new-base)
 	    (not old-base))
 	new-base



From lgiessmann at common-lisp.net  Tue Aug 18 13:50:25 2009
From: lgiessmann at common-lisp.net (Lukas Giessmann)
Date: Tue, 18 Aug 2009 09:50:25 -0400
Subject: [isidorus-cvs] r115 - trunk/src/xml/rdf
Message-ID: <E1MdP4z-0003yK-DW@common-lisp.net>

Author: lgiessmann
Date: Tue Aug 18 09:50:24 2009
New Revision: 115

Log:
rdf-mporter: moved all calls of the elephant-macro "ensure-transaction" to the two public and top layered functions "setup-rdf-module" and "rdf-importer"

Modified:
   trunk/src/xml/rdf/importer.lisp
   trunk/src/xml/rdf/rdf_tools.lisp

Modified: trunk/src/xml/rdf/importer.lisp
==============================================================================
--- trunk/src/xml/rdf/importer.lisp	(original)
+++ trunk/src/xml/rdf/importer.lisp	Tue Aug 18 09:50:24 2009
@@ -41,12 +41,13 @@
     (unless elephant:*store-controller*
       (elephant:open-store
        (get-store-spec repository-path)))
-    (let ((rdf-dom
-	   (dom:document-element (cxml:parse-file
-				  (truename rdf-xml-path)
-				  (cxml-dom:make-dom-builder)))))
-      (import-dom rdf-dom start-revision :tm-id tm-id :document-id document-id))
-    (setf *_n-map* nil)))
+    (elephant:ensure-transaction (:txn-nosync t)
+      (let ((rdf-dom
+	     (dom:document-element (cxml:parse-file
+				    (truename rdf-xml-path)
+				    (cxml-dom:make-dom-builder)))))
+	(import-dom rdf-dom start-revision :tm-id tm-id :document-id document-id))
+      (setf *_n-map* nil))))
 
 
 (defun init-rdf-module (&optional (revision (get-revision)))
@@ -57,22 +58,16 @@
       (let
 	  ((core-dom 
 	    (cxml:parse-file *rdf_core_psis.xtm* (cxml-dom:make-dom-builder))))
-	(loop for top-elem across 
-	     (xpath-child-elems-by-qname (dom:document-element core-dom)
-					 *xtm2.0-ns* "topic")
-	   do
-	     (let
-		 ((top
-		   (from-topic-elem-to-stub top-elem revision
-					    :xtm-id *rdf-core-xtm*)))
-	       (add-to-topicmap xml-importer::tm top)))))))
-
-
-(defun tm-id-p (tm-id fun-name)
-  "Checks the validity of the passed tm-id."
-  (unless (absolute-uri-p tm-id)
-    (error "From ~a(): you must provide a stable identifier (PSI-style) for this TM: ~a!"
-	   fun-name tm-id)))
+	(elephant:ensure-transaction (:txn-nosync t)
+	  (loop for top-elem across 
+	       (xpath-child-elems-by-qname (dom:document-element core-dom)
+					   *xtm2.0-ns* "topic")
+	     do
+	       (let
+		   ((top
+		     (from-topic-elem-to-stub top-elem revision
+					      :xtm-id *rdf-core-xtm*)))
+		 (add-to-topicmap xml-importer::tm top))))))))
 
 
 (defun import-dom (rdf-dom start-revision
@@ -126,24 +121,23 @@
 	  (super-classes
 	   (get-super-classes-of-node-content elem tm-id xml-base)))
       (with-tm (start-revision document-id tm-id)
-	(elephant:ensure-transaction (:txn-nosync t)
-	  (let ((this
-		 (make-topic-stub
-		  about ID nodeID UUID start-revision xml-importer::tm
-		  :document-id document-id)))
-	    (make-literals this literals tm-id start-revision
-			   :document-id document-id)
-	    (make-associations this associations xml-importer::tm
-			       start-revision :document-id document-id)
-	    (make-types this types xml-importer::tm start-revision
-			:document-id document-id)
-	    (make-super-classes this super-classes xml-importer::tm
-				start-revision :document-id document-id)
-	    (make-recursion-from-node elem tm-id start-revision
-				      :document-id document-id
-				      :xml-base xml-base
-				      :xml-lang xml-lang)
-	    this)))))))
+	(let ((this
+	       (make-topic-stub
+		about ID nodeID UUID start-revision xml-importer::tm
+		:document-id document-id)))
+	  (make-literals this literals tm-id start-revision
+			 :document-id document-id)
+	  (make-associations this associations xml-importer::tm
+			     start-revision :document-id document-id)
+	  (make-types this types xml-importer::tm start-revision
+		      :document-id document-id)
+	  (make-super-classes this super-classes xml-importer::tm
+			      start-revision :document-id document-id)
+	  (make-recursion-from-node elem tm-id start-revision
+				    :document-id document-id
+				    :xml-base xml-base
+				    :xml-lang xml-lang)
+	  this))))))
 
 
 (defun import-arc (elem tm-id start-revision
@@ -360,21 +354,20 @@
     (unless (or role-type-1 role-type-2)
       (error "~aone of the role types ~a ~a is missing!"
 	     err-pref *supertype-psi* *subtype-psi*))
-    (elephant:ensure-transaction (:txn-nosync t)
-      (let ((a-roles (list (list :instance-of role-type-1
-				 :player super-top)
-			   (list :instance-of role-type-2
-				 :player sub-top))))
-	(when reifier-id
-	  (make-reification reifier-id sub-top super-top
-			    assoc-type start-revision tm
-			    :document-id document-id))
-	(add-to-topicmap
-	 tm
-	 (make-construct 'AssociationC
-			 :start-revision start-revision
-			 :instance-of assoc-type
-			 :roles a-roles))))))
+    (let ((a-roles (list (list :instance-of role-type-1
+			       :player super-top)
+			 (list :instance-of role-type-2
+			       :player sub-top))))
+      (when reifier-id
+	(make-reification reifier-id sub-top super-top
+			  assoc-type start-revision tm
+			  :document-id document-id))
+      (add-to-topicmap
+       tm
+       (make-construct 'AssociationC
+		       :start-revision start-revision
+		       :instance-of assoc-type
+		       :roles a-roles)))))
 
 
 (defun make-instance-of-association (instance-top type-top reifier-id
@@ -399,21 +392,20 @@
     (unless (or roletype-1 roletype-2)
       (error "~aone of the role types ~a ~a is missing!"
 	     err-pref *type-psi* *instance-psi*))
-    (elephant:ensure-transaction (:txn-nosync t)
-      (let ((a-roles (list (list :instance-of roletype-1
-				 :player type-top)
-			   (list :instance-of roletype-2
-				 :player instance-top))))
-	(when reifier-id
-	  (make-reification reifier-id instance-top type-top
-			    assoc-type start-revision tm
-			    :document-id document-id))
-	(add-to-topicmap
-	 tm
-	 (make-construct 'AssociationC
-			 :start-revision start-revision
-			 :instance-of assoc-type
-			 :roles a-roles))))))
+    (let ((a-roles (list (list :instance-of roletype-1
+			       :player type-top)
+			 (list :instance-of roletype-2
+			       :player instance-top))))
+      (when reifier-id
+	(make-reification reifier-id instance-top type-top
+			  assoc-type start-revision tm
+			  :document-id document-id))
+      (add-to-topicmap
+       tm
+       (make-construct 'AssociationC
+		       :start-revision start-revision
+		       :instance-of assoc-type
+		       :roles a-roles)))))
 
 
 (defun make-topic-stub (about ID nodeId UUID start-revision
@@ -438,20 +430,19 @@
 	       inner-top))))
       (if top
 	  top
-	  (elephant:ensure-transaction (:txn-nosync t)
-	    (let ((psi (when psi-uri
-			 (make-instance 'PersistentIdC
-					:uri psi-uri
-					:start-revision start-revision))))
-	      (handler-case (add-to-topicmap
-			     tm
-			     (make-construct 'TopicC
-					     :topicid topic-id
-					     :psis (when psi (list psi))
-					     :xtm-id document-id
-					     :start-revision start-revision))
-		(Condition (err)(error "Creating topic ~a failed: ~a"
-				       topic-id err)))))))))
+	  (let ((psi (when psi-uri
+		       (make-instance 'PersistentIdC
+				      :uri psi-uri
+				      :start-revision start-revision))))
+	    (handler-case (add-to-topicmap
+			   tm
+			   (make-construct 'TopicC
+					   :topicid topic-id
+					   :psis (when psi (list psi))
+					   :xtm-id document-id
+					   :start-revision start-revision))
+	      (Condition (err)(error "Creating topic ~a failed: ~a"
+				     topic-id err))))))))
 
 
 (defun make-lang-topic (lang start-revision tm
@@ -479,30 +470,29 @@
 	(player-id (getf association :topicid))
 	(player-psi (getf association :psi))
 	(ID (getf association :ID)))
-    (elephant:ensure-transaction (:txn-nosync t)
-      (let ((player-1 (make-topic-stub player-psi nil player-id nil
-				       start-revision
-				       tm :document-id document-id))
-	    (role-type-1
-	     (make-topic-stub *rdf2tm-object* nil nil nil
-			      start-revision tm :document-id document-id))
-	    (role-type-2
-	     (make-topic-stub *rdf2tm-subject* nil nil nil
-			      start-revision tm :document-id document-id))
-	    (type-top (make-topic-stub type nil nil nil start-revision
-				       tm :document-id document-id)))
-	(let ((roles (list (list :instance-of role-type-1
-				 :player player-1)
-			   (list :instance-of role-type-2
-				 :player top))))
-	  (when ID
-	    (make-reification ID top player-1 type-top start-revision
-			      tm :document-id document-id))
-	  (add-to-topicmap tm (make-construct 'AssociationC
-					      :start-revision start-revision
-					      :instance-of type-top
-					      :roles roles)))))))
-  
+    (let ((player-1 (make-topic-stub player-psi nil player-id nil
+				     start-revision
+				     tm :document-id document-id))
+	  (role-type-1
+	   (make-topic-stub *rdf2tm-object* nil nil nil
+			    start-revision tm :document-id document-id))
+	  (role-type-2
+	   (make-topic-stub *rdf2tm-subject* nil nil nil
+			    start-revision tm :document-id document-id))
+	  (type-top (make-topic-stub type nil nil nil start-revision
+				     tm :document-id document-id)))
+      (let ((roles (list (list :instance-of role-type-1
+			       :player player-1)
+			 (list :instance-of role-type-2
+			       :player top))))
+	(when ID
+	  (make-reification ID top player-1 type-top start-revision
+			    tm :document-id document-id))
+	(add-to-topicmap tm (make-construct 'AssociationC
+					    :start-revision start-revision
+					    :instance-of type-top
+					    :roles roles))))))
+
 
 (defun make-association-with-nodes (subject-topic object-topic
 				    associationtype-topic tm start-revision
@@ -520,11 +510,10 @@
 			     :player subject-topic)
 		       (list :instance-of role-type-2
 			     :player object-topic))))
-      (elephant:ensure-transaction (:txn-nosync t)
-	(add-to-topicmap tm (make-construct 'AssociationC
-					    :start-revision start-revision
-					    :instance-of associationtype-topic
-					    :roles roles))))))
+      (add-to-topicmap tm (make-construct 'AssociationC
+					  :start-revision start-revision
+					  :instance-of associationtype-topic
+					  :roles roles)))))
 
 
 (defun make-reification (reifier-id subject object predicate start-revision tm
@@ -545,24 +534,23 @@
 				      tm :document-id document-id))
 	(statement (make-topic-stub *rdf-statement* nil nil nil start-revision
 				    tm :document-id document-id)))
-    (elephant:ensure-transaction (:txn-nosync t)
-      (make-instance-of-association reifier statement nil start-revision tm
-				    :document-id document-id)
-      (make-association-with-nodes reifier subject subject-arc tm
-				   start-revision :document-id document-id)
-      (make-association-with-nodes reifier predicate predicate-arc
-				   tm start-revision :document-id document-id)
-      (if (typep object 'd:TopicC)
-	  (make-association-with-nodes reifier object object-arc
-				       tm start-revision
-				       :document-id document-id)
-	  (make-construct 'd:OccurrenceC
-			  :start-revision start-revision
-			  :topic reifier
-			  :themes (themes object)
-			  :instance-of (instance-of object)
-			  :charvalue (charvalue object)
-			  :datatype (datatype object))))))
+    (make-instance-of-association reifier statement nil start-revision tm
+				  :document-id document-id)
+    (make-association-with-nodes reifier subject subject-arc tm
+				 start-revision :document-id document-id)
+    (make-association-with-nodes reifier predicate predicate-arc
+				 tm start-revision :document-id document-id)
+    (if (typep object 'd:TopicC)
+	(make-association-with-nodes reifier object object-arc
+				     tm start-revision
+				     :document-id document-id)
+	(make-construct 'd:OccurrenceC
+			:start-revision start-revision
+			:topic reifier
+			:themes (themes object)
+			:instance-of (instance-of object)
+			:charvalue (charvalue object)
+			:datatype (datatype object)))))
 
 
 (defun make-occurrence (top literal start-revision tm-id 
@@ -577,26 +565,25 @@
 	  (lang (getf literal :lang))
 	  (datatype (getf literal :datatype))
 	  (ID (getf literal :ID)))
-      (elephant:ensure-transaction (:txn-nosync t)
-	(let ((type-top (make-topic-stub type nil nil nil start-revision
-					 xml-importer::tm
-					 :document-id document-id))
-	      (lang-top (make-lang-topic lang start-revision
-					 xml-importer::tm
-					 :document-id document-id)))
-	  (let ((occurrence
-		 (make-construct 'OccurrenceC 
-				 :start-revision start-revision
-				 :topic top
-				 :themes (when lang-top
-					   (list lang-top))
-				 :instance-of type-top
-				 :charvalue value
-				 :datatype datatype)))
-	    (when ID
-	      (make-reification ID top occurrence type-top start-revision
-				xml-importer::tm :document-id document-id))
-	    occurrence))))))
+      (let ((type-top (make-topic-stub type nil nil nil start-revision
+				       xml-importer::tm
+				       :document-id document-id))
+	    (lang-top (make-lang-topic lang start-revision
+				       xml-importer::tm
+				       :document-id document-id)))
+	(let ((occurrence
+	       (make-construct 'OccurrenceC 
+			       :start-revision start-revision
+			       :topic top
+			       :themes (when lang-top
+					 (list lang-top))
+			       :instance-of type-top
+			       :charvalue value
+			       :datatype datatype)))
+	  (when ID
+	    (make-reification ID top occurrence type-top start-revision
+			      xml-importer::tm :document-id document-id))
+	  occurrence)))))
 	    
 
 (defun get-literals-of-node-content (node tm-id xml-base xml-lang)

Modified: trunk/src/xml/rdf/rdf_tools.lisp
==============================================================================
--- trunk/src/xml/rdf/rdf_tools.lisp	(original)
+++ trunk/src/xml/rdf/rdf_tools.lisp	Tue Aug 18 09:50:24 2009
@@ -459,4 +459,11 @@
 	   (get-absolute-attribute elem tm-id fn-xml-base "datatype")))
       (if datatype
 	  datatype
-	  *xml-string*))))
\ No newline at end of file
+	  *xml-string*))))
+
+
+(defun tm-id-p (tm-id fun-name)
+  "Checks the validity of the passed tm-id."
+  (unless (absolute-uri-p tm-id)
+    (error "From ~a(): you must provide a stable identifier (PSI-style) for this TM: ~a!"
+	   fun-name tm-id)))
\ No newline at end of file



From lgiessmann at common-lisp.net  Tue Aug 18 17:16:22 2009
From: lgiessmann at common-lisp.net (Lukas Giessmann)
Date: Tue, 18 Aug 2009 13:16:22 -0400
Subject: [isidorus-cvs] r116 - in trunk/src: unit_tests xml/rdf
Message-ID: <E1MdSII-0001bv-DZ@common-lisp.net>

Author: lgiessmann
Date: Tue Aug 18 13:16:21 2009
New Revision: 116

Log:
rdf-importer: fixed a bug with parsing property nodes

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	Tue Aug 18 13:16:21 2009
@@ -332,7 +332,6 @@
 	  (dom:set-attribute-ns prop *rdf-ns* "unknown" "unknown")
 	  (is-true (rdf-importer::parse-property prop 0))
 	  (dom:append-child prop text-node)
-	  (signals error (rdf-importer::parse-property prop 0))
 	  (dom:remove-child prop text-node)
 	  (is-true (rdf-importer::parse-property prop 0))
 	  (dom:remove-attribute-ns prop *rdf-ns* "unknown")

Modified: trunk/src/xml/rdf/importer.lisp
==============================================================================
--- trunk/src/xml/rdf/importer.lisp	(original)
+++ trunk/src/xml/rdf/importer.lisp	Tue Aug 18 13:16:21 2009
@@ -876,8 +876,8 @@
       (error "~aliteral content not allowed here: ~a"
 	     err-pref content))
     (loop for arc across content
-       do (import-arc arc tm-id start-revision :document-id document-id
-		      :xml-base fn-xml-base :xml-lang fn-xml-lang))))
+       collect (import-arc arc tm-id start-revision :document-id document-id
+			   :xml-base fn-xml-base :xml-lang fn-xml-lang))))
 
 
 (defun make-recursion-from-arc (arc tm-id 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	Tue Aug 18 13:16:21 2009
@@ -359,24 +359,29 @@
     (when (and nodeID resource)
       (error "~aondly one of rdf:nodeID and rdf:resource is allowed: (~a) (~a)!"
 	     err-pref nodeID resource))
-    (when (and (or nodeID resource type)
+    (when (and (or nodeID resource type literals)
 	       datatype)
       (error "~aonly one of ~a and rdf:datatype (~a) is allowed!"
 	     err-pref
 	     (cond
 	       (nodeID (concatenate 'string "rdf:nodeID (" nodeID ")"))
 	       (resource (concatenate 'string "rdf:resource (" resource ")"))
-	       (type (concatenate 'string "rdf:type (" type ")")))
+	       (type (concatenate 'string "rdf:type (" type ")"))
+	       (literals literals))
 	     datatype))
-    (when (and (or type nodeID resource)
+    (when (and (or nodeID resource)
 	       (> (length content) 0))
       (error "~awhen ~a is set no content is allowed: ~a!"
 	     err-pref
 	     (cond
-	       (type (concatenate 'string "rdf:type (" type ")"))
 	       (nodeID (concatenate 'string "rdf:nodeID (" nodeID ")"))
 	       (resource (concatenate 'string "rdf:resource (" resource ")")))
 	     content))
+    (when (and type
+	       (stringp content)
+	       (> (length content) 0))
+      (error "~awhen rdf:type is set no literal content is allowed: ~a!"
+	     err-pref content))
     (when (and (or type
 		   (and (string= node-name "type")
 			(string= node-ns *rdf-ns*))



From lgiessmann at common-lisp.net  Mon Aug 24 16:37:41 2009
From: lgiessmann at common-lisp.net (Lukas Giessmann)
Date: Mon, 24 Aug 2009 12:37:41 -0400
Subject: [isidorus-cvs] r117 - in trunk/src: . model unit_tests xml/rdf
Message-ID: <E1MfcY9-0002bL-M8@common-lisp.net>

Author: lgiessmann
Date: Mon Aug 24 12:37:40 2009
New Revision: 117

Log:
rdf-exporter: implemented a part of the rdf-exporter. currently associations, that do not represent type-instance or supertype-subtype associations are not exported; unit tests are not implemented at the moment, there is just a test file which can be xported "poems_light.xtm"

Added:
   trunk/src/unit_tests/poems_light.xtm
Modified:
   trunk/src/constants.lisp
   trunk/src/isidorus.asd
   trunk/src/model/datamodel.lisp
   trunk/src/unit_tests/poems.rdf
   trunk/src/unit_tests/poems_light.rdf
   trunk/src/unit_tests/rdf_importer_test.lisp
   trunk/src/xml/rdf/exporter.lisp
   trunk/src/xml/rdf/importer.lisp
   trunk/src/xml/rdf/rdf_core_psis.xtm
   trunk/src/xml/rdf/rdf_tools.lisp

Modified: trunk/src/constants.lisp
==============================================================================
--- trunk/src/constants.lisp	(original)
+++ trunk/src/constants.lisp	Mon Aug 24 12:37:40 2009
@@ -27,6 +27,7 @@
 	   :*xml-ns*
 	   :*xmlns-ns*
 	   :*xml-string*
+	   :*xml-uri*
 	   :*rdf2tm-ns*
 	   :*rdf-statement*
 	   :*rdf-object*
@@ -37,7 +38,8 @@
 	   :*rdf-rest*
 	   :*rdf2tm-object*
 	   :*rdf2tm-subject*
-	   :*rdf2tm-scope-prefix*))
+	   :*rdf2tm-scope-prefix*
+	   :*tm2rdf-ns*))
 
 (in-package :constants)
 (defparameter *xtm2.0-ns* "http://www.topicmaps.org/xtm/")
@@ -74,7 +76,9 @@
 
 (defparameter *xml-string* "http://www.w3.org/2001/XMLSchema#string")
 
-(defparameter *rdf2tm-ns* "http://isidorus/rdf2tm_mapping#")
+(defparameter *xml-uri* "http://www.w3.org/2001/XMLSchema#anyURI")
+
+(defparameter *rdf2tm-ns* "http://isidorus/rdf2tm_mapping/")
 
 (defparameter *rdf-statement* "http://www.w3.org/1999/02/22-rdf-syntax-ns#Statement")
 
@@ -90,8 +94,10 @@
 
 (defparameter *rdf-rest* "http://www.w3.org/1999/02/22-rdf-syntax-ns#rest")
 
-(defparameter *rdf2tm-object* "http://isidorus/rdf2tm_mapping#object")
+(defparameter *rdf2tm-object* "http://isidorus/rdf2tm_mapping/object")
+
+(defparameter *rdf2tm-subject* "http://isidorus/rdf2tm_mapping/subject")
 
-(defparameter *rdf2tm-subject* "http://isidorus/rdf2tm_mapping#subject")
+(defparameter *rdf2tm-scope-prefix* "http://isidorus/rdf2tm_mapping/scope/")
 
-(defparameter *rdf2tm-scope-prefix* "http://isidorus/rdf2tm_mapping/scope#")
\ No newline at end of file
+(defparameter *tm2rdf-ns* "http://isidorus/tm2rdf_mapping/")
\ No newline at end of file

Modified: trunk/src/isidorus.asd
==============================================================================
--- trunk/src/isidorus.asd	(original)
+++ trunk/src/isidorus.asd	Mon Aug 24 12:37:40 2009
@@ -107,6 +107,7 @@
 				     (:static-file "poems.xtm")
 				     (:static-file "poems.rdf")
 				     (:static-file "poems_light.rdf")
+				     (:static-file "poems_light.xtm")
 				     (:file "atom-conf")
 				     (:file "unittests-constants"
 					    :depends-on ("dangling_topicref.xtm"

Modified: trunk/src/model/datamodel.lisp
==============================================================================
--- trunk/src/model/datamodel.lisp	(original)
+++ trunk/src/model/datamodel.lisp	Mon Aug 24 12:37:40 2009
@@ -66,6 +66,7 @@
            :item-identifiers
            :item-identifiers-p
            :list-instanceOf
+	   :list-super-types
            :locators
            :locators-p
            :make-construct
@@ -105,6 +106,8 @@
            :*TM-REVISION*
 
            :with-revision ;;macros
+
+	   :string-starts-with ;;helpers
            ))
 
 (declaim (optimize (debug 3) (safety 3) (speed 0) (space 0)))
@@ -647,7 +650,6 @@
                 (elephant:get-instances-by-value 'PersistentIdC 'uri (uri id))
                 (elephant:get-instances-by-value 'SubjectLocatorC 'uri (uri id)))))
              1)
-      ;(format t "cfdi: ~A --> ~A~%" construct (item-identifiers construct))
       (error 
        (make-condition 'duplicate-identifier-error 
                        :message (format nil "Duplicate Identifier ~a has been found" (uri id))
@@ -1174,6 +1176,33 @@
              (player-in-roles topic))
             (player-in-roles topic)))))
 
+
+(defgeneric list-super-types (topic &key tm)
+ (:documentation "Generate a list of all topics that this topic is an
+  subclass of, optionally filtered by a topic map"))
+
+
+(defmethod list-super-types ((topic TopicC)  &key (tm nil))
+  (remove-if 
+   #'null
+   (map 'list #'(lambda(x)
+                  (when (loop for psi in (psis (instance-of x))
+                           when (string= (uri psi) *subtype-psi*)
+                           return t)
+                    (loop for role in (roles (parent x))
+                       when (not (eq role x))
+                       return (player role))))
+        (if tm
+            (remove-if-not 
+             (lambda (role)
+               (format t "player: ~a" (player role))
+               (format t "parent: ~a" (parent role))
+               (format t "topic: ~a~&" topic)
+               (in-topicmap tm (parent role)))
+             (player-in-roles topic))
+            (player-in-roles topic)))))
+
+
 (defun string-starts-with (str prefix)
   "Checks if string str starts with a given prefix"
   (declare (string str prefix))

Modified: trunk/src/unit_tests/poems.rdf
==============================================================================
--- trunk/src/unit_tests/poems.rdf	(original)
+++ trunk/src/unit_tests/poems.rdf	Mon Aug 24 12:37:40 2009
@@ -248,8 +248,8 @@
 	<rdf:type rdf:resource="/types/Poem"/>
 	<arcs:dateRange>
 	  <rdf:Description xml:base="http://does.not.exist">
-	    <arcs:start rdf:datatype="http://www.w3.org/2001/XMLSchema#date">1772</arcs:start>
-	    <arcs:end rdf:datatype="http://www.w3.org/2001/XMLSchema#date">1774</arcs:end>
+	    <arcs:start rdf:datatype="http://www.w3.org/2001/XMLSchema#date">01.01.1772</arcs:start>
+	    <arcs:end rdf:datatype="http://www.w3.org/2001/XMLSchema#date">31.12.1774</arcs:end>
 	  </rdf:Description>
 	</arcs:dateRange>
 	<arcs:content rdf:parseType="Literal" xml:lang="de">

Modified: trunk/src/unit_tests/poems_light.rdf
==============================================================================
--- trunk/src/unit_tests/poems_light.rdf	(original)
+++ trunk/src/unit_tests/poems_light.rdf	Mon Aug 24 12:37:40 2009
@@ -73,119 +73,7 @@
 	      <arcs:start rdf:datatype="#date">01.01.1797</arcs:start>
 	      <arcs:end rdf:datatype="#date">31.12.1797</arcs:end>
 	    </arcs:dateRange>
-	    <arcs:content xml:lang="de">
-	      <![CDATA[Hat der alte Hexenmeister
-sich doch einmal wegbegeben!
-Und nun sollen seine Geister
-auch nach meinem Willen leben.
-Seine Wort und Werke
-merkt ich und den Brauch,
-und mit Geistesst?rke
-tu ich Wunder auch.
-
-Walle! walle
-Manche Strecke,
-da?, zum Zwecke,
-Wasser flie?e
-und mit reichem, vollem Schwalle
-zu dem Bade sich ergie?e.
-
-Und nun komm, du alter Besen!
-Nimm die schlechten Lumpenh?llen;
-bist schon lange Knecht gewesen:
-nun erf?lle meinen Willen!
-Auf zwei Beinen stehe,
-oben sei ein Kopf,
-eile nun und gehe
-mit dem Wassertopf!
-
-Walle! walle
-manche Strecke,
-da?, zum Zwecke,
-Wasser flie?e
-und mit reichem, vollem Schwalle
-zu dem Bade sich ergie?e.
-
-Seht, er l?uft zum Ufer nieder,
-Wahrlich! ist schon an dem Flusse,
-und mit Blitzesschnelle wieder
-ist er hier mit raschem Gusse.
-Schon zum zweiten Male!
-Wie das Becken schwillt!
-Wie sich jede Schale
-voll mit Wasser f?llt!
-
-Stehe! stehe!
-denn wir haben
-deiner Gaben
-vollgemessen! -
-Ach, ich merk es! Wehe! wehe!
-Hab ich doch das Wort vergessen!
-
-Ach, das Wort, worauf am Ende
-er das wird, was er gewesen.
-Ach, er l?uft und bringt behende!
-W?rst du doch der alte Besen!
-Immer neue G?sse
-bringt er schnell herein,
-Ach! und hundert Fl?sse
-st?rzen auf mich ein.
-
-Nein, nicht l?nger
-kann ichs lassen;
-will ihn fassen.
-Das ist T?cke!
-Ach! nun wird mir immer b?nger!
-Welche Mine! welche Blicke!
-
-O du Ausgeburt der H?lle!
-Soll das ganze Haus ersaufen?
-Seh ich ?ber jede Schwelle
-doch schon Wasserstr?me laufen.
-Ein verruchter Besen,
-der nicht h?ren will!
-Stock, der du gewesen,
-steh doch wieder still!
-
-Willst am Ende
-gar nicht lassen?
-Will dich fassen,
-will dich halten
-und das alte Holz behende
-mit dem scharfen Beile spalten.
-
-Seht da kommt er schleppend wieder!
-Wie ich mich nur auf dich werfe,
-gleich, o Kobold, liegst du nieder;
-krachend trifft die glatte Sch?rfe.
-Wahrlich, brav getroffen!
-Seht, er ist entzwei!
-Und nun kann ich hoffen,
-und ich atme frei!
-
-Wehe! wehe!
-Beide Teile
-stehn in Eile
-schon als Knechte
-v?llig fertig in die H?he!
-Helft mir, ach! ihr hohen M?chte!
-
-Und sie laufen! Na? und n?sser
-wirds im Saal und auf den Stufen.
-Welch entsetzliches Gew?sser!
-Herr und Meister! h?r mich rufen! -
-Ach, da kommt der Meister!
-Herr, die Not ist gro?!
-Die ich rief, die Geister
-werd ich nun nicht los.
-
-"In die Ecke,
-Besen, Besen!
-Seids gewesen.
-Denn als Geister
-ruft euch nur zu diesem Zwecke,
-erst hervor der alte Meister."]]>
-	    </arcs:content>
+	    <arcs:content xml:lang="de"><![CDATA[Hat der alte Hexenmeister ...]]></arcs:content>
 	  </types:Poem>
 	</rdf:li>
       </rdf:Bag>
@@ -200,47 +88,7 @@
 	  <arcs:start rdf:datatype="#date">01.01.1782</arcs:start>
 	  <arcs:end  rdf:datatype="#date">31.12.1782</arcs:end>
 	</arcs:dateRange>
-	<arcs:content rdf:datatype="http://www.w3.org/2001/XMLSchema#string" xml:lang="de">
-	  <![CDATA[Wer reitet so sp?t durch Nacht und Wind?
-Es ist der Vater mit seinem Kind;
-Er hat den Knaben wohl in dem Arm,
-Er fa?t ihn sicher, er h?lt ihn warm.
-
-Mein Sohn, was birgst du so bang dein Gesicht? -
-Siehst Vater, du den Erlk?nig nicht?
-Den Erlenk?nig mit Kron und Schweif? -
-Mein Sohn, es ist ein Nebelstreif. -
-
-"Du liebes Kind, komm, geh mit mir!
-Gar sch?ne Spiele spiel ich mit dir;
-Manch bunte Blumen sind an dem Strand,
-Meine Mutter hat manch g?lden Gewand."
-
-Mein Vater, mein Vater, und h?rest du nicht,
-Was Erlenk?nig mir leise verspricht? -
-Sei ruhig, bleibe ruhig, mein Kind;
-In d?rren Bl?ttern s?uselt der Wind. -
-
-"Willst, feiner Knabe, du mit mir gehn?
-Meine T?chter sollen dich warten sch?n;
-Meine T?chter f?hren den n?chtlichen Reihn
-Und wiegen und tanzen und singen dich ein."
-
-Mein Vater, mein Vater, und siehst du nicht dort
-Erlk?nigs T?chter am d?stern Ort? -
-Mein Sohn, mein Sohn, ich seh es genau:
-Es scheinen die alten Weiden so grau. -
-
-"Ich liebe dich, mich reizt deine sch?ne Gestalt;
-Und bist du nicht willig, so brauch ich Gewalt."
-Mein Vater, mein Vater, jetzt fa?t er mich an!
-Erlk?nig hat mir ein Leids getan! -
-
-Dem Vater grauset's, er reitet geschwind,
-Er h?lt in den Armen das ?chzende Kind,
-Erreicht den Hof mit M?he und Not;
-In seinen Armen das Kind war tot.]]>
-	</arcs:content>
+	<arcs:content rdf:datatype="http://www.w3.org/2001/XMLSchema#string" xml:lang="de">Wer reitet so sp?t durch Nacht und Wind? ...</arcs:content>
       </types:Ballad>
     </rdf:li>
     <rdf:li>
@@ -248,76 +96,11 @@
 	<rdf:type rdf:resource="/types/Poem"/>
 	<arcs:dateRange>
 	  <rdf:Description xml:base="http://does.not.exist">
-	    <arcs:start rdf:datatype="http://www.w3.org/2001/XMLSchema#date">1772</arcs:start>
-	    <arcs:end rdf:datatype="http://www.w3.org/2001/XMLSchema#date">1774</arcs:end>
+	    <arcs:start rdf:datatype="http://www.w3.org/2001/XMLSchema#date">01.01.1772</arcs:start>
+	    <arcs:end rdf:datatype="http://www.w3.org/2001/XMLSchema#date">31.12.1774</arcs:end>
 	  </rdf:Description>
 	</arcs:dateRange>
-	<arcs:content rdf:parseType="Literal" xml:lang="de">
-	  <![CDATA[Bedecke deinen Himmel, Zeus,
-Mit Wolkendunst!
-Und ?be, Knaben gleich,
-Der Disteln k?pft,
-An Eichen dich und Bergesh?h'n!
-Mu?t mir meine Erde
-Doch lassen steh'n,
-Und meine H?tte,
-Die du nicht gebaut,
-Und meinen Herd,
-Um dessen Glut
-Du mich beneidest.
-
-Ich kenne nichts ?rmeres
-Unter der Sonn' als euch G?tter!
-Ihr n?hret k?mmerlich
-Von Opfersteuern
-Und Gebetshauch
-Eure Majest?t
-Und darbtet, w?ren
-Nicht Kinder und Bettler
-Hoffnungsvolle Toren.
-
-Da ich ein Kind war,
-Nicht wu?te, wo aus, wo ein,
-Kehrt' ich mein verirrtes Auge
-Zur Sonne, als wenn dr?ber w?r
-Ein Ohr zu h?ren meine Klage,
-Ein Herz wie meins,
-Sich des Bedr?ngten zu erbarmen.
-
-Wer half mir
-Wider der Titanen ?bermut?
-Wer rettete vom Tode mich,
-Von Sklaverei?
-Hast du's nicht alles selbst vollendet,
-Heilig gl?hend Herz?
-Und gl?htest, jung und gut,
-Betrogen, Rettungsdank
-Dem Schlafenden dadroben?
-
-Ich dich ehren? Wof?r?
-Hast du die Schmerzen gelindert
-Je des Beladenen?
-Hast du die Tr?nen gestillet
-Je des Ge?ngsteten?
-Hat nicht mich zum Manne geschmiedet
-Die allm?chtige Zeit
-Und das ewige Schicksal,
-Meine Herren und deine?
-
-W?hntest du etwa,
-Ich sollte das Leben hassen,
-In W?sten fliehn,
-Weil nicht alle Knabenmorgen-
-Bl?tentr?ume reiften?
-
-Hier sitz' ich, forme Menschen
-Nach meinem Bilde,
-Ein Geschlecht, das mir gleich sei,
-Zu leiden, weinen,
-Genie?en und zu freuen sich,
-Und dein nicht zu achten,
-Wie ich!]]>
-	</arcs:content>
+	<arcs:content rdf:parseType="Literal" xml:lang="de"><![CDATA[ Bedecke deinen Himmel, Zeus, ... ]]></arcs:content>
       </rdf:Description>
     </rdf:li>
   </rdf:Description>

Added: trunk/src/unit_tests/poems_light.xtm
==============================================================================
--- (empty file)
+++ trunk/src/unit_tests/poems_light.xtm	Mon Aug 24 12:37:40 2009
@@ -0,0 +1,578 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<tm:topicMap version="2.0" xmlns:tm="http://www.topicmaps.org/xtm/">
+  <!-- this file contains constructs that are originally defined as TM and
+       RDF, so certain constructs are not consistent because of test cases -->
+  <tm:topic id="goethe">
+    <tm:subjectIdentifier href="http://some.where/author/Goehte"/>
+    <tm:instanceOf><tm:topicRef href="#author"/></tm:instanceOf>
+    <tm:name>
+      <tm:type><tm:topicRef href="#firstName"/></tm:type>
+      <tm:value>Johann Wolfgang</tm:value>
+    </tm:name>
+    <tm:occurrence>
+      <tm:type><tm:topicRef href="#lastName"/></tm:type>
+      <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string">von Goethe</tm:resourceData>
+    </tm:occurrence>
+  </tm:topic>
+
+  <tm:topic id="UUID-born-event">
+    <tm:instanceOf href="#event"/>
+    <tm:occurrence>
+      <tm:type><tm:topicRef href="#date"/></tm:type>
+      <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#date">28.08.1749</tm:resourceData>
+    </tm:occurrence>
+  </tm:topic>
+
+  <tm:topic id="frankfurt_m">
+    <tm:subjectIdentifier href="http://some.where/metropolis/FrankfurtMain"/>
+    <tm:instanceOf><tm:topicRef href="#metropolis"/></tm:instanceOf>
+    <tm:occurrence>
+      <tm:type><tm:topicRef href="#population"/></tm:type>
+      <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#unsignedLong">659000</tm:resourceData>
+    </tm:occurrence>
+    <tm:occurrence>
+      <tm:type><tm:topicRef href="#fullName"/></tm:type>
+      <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string">Frankfurt am Main</tm:resourceData>
+    </tm:occurrence>
+  </tm:topic>
+
+  <tm:topic id="germany">
+    <tm:subjectIdentifier href="http://some.where/country/Germany"/>
+    <tm:instanceOf><tm:topicRef href="#country"/></tm:instanceOf>
+    <tm:occurrence>
+      <tm:type><tm:topicRef href="#nativeName"/></tm:type>
+      <tm:scope><tm:topicRef href="#de"/></tm:scope>
+      <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string">Deutschland</tm:resourceData>
+    </tm:occurrence>
+    <tm:occurrence>
+      <tm:type><tm:topicRef href="#population"/></tm:type>
+      <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#unsignedLong">82099232</tm:resourceData>
+    </tm:occurrence>
+  </tm:topic>
+
+  <tm:topic id="berlin">
+    <tm:subjectIdentifier href="http://some.where/metropolis/Berlin"/>
+    <tm:instanceOf><tm:topicRef href="#metropolis"/></tm:instanceOf>
+    <tm:occurrence>
+      <tm:type><tm:topicRef href="#population"/></tm:type>
+      <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#unsignedLong">3431473</tm:resourceData>
+    </tm:occurrence>
+  </tm:topic>
+
+  <tm:topic id="UUID-died-event">
+    <tm:instanceOf><tm:topicRef href="#event"/></tm:instanceOf>
+    <tm:occurrence>
+      <tm:type><tm:topicRef href="#date"/></tm:type>
+      <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#date">22.03.1832</tm:resourceData>
+    </tm:occurrence>
+  </tm:topic>
+
+  <tm:topic id="weimar">
+    <tm:subjectIdentifier href="http://some.where/city/Weimar"/>
+    <tm:instanceOf><tm:topicRef href="#city"/></tm:instanceOf>
+    <tm:occurrence>
+      <tm:type><tm:topicRef href="#population"/></tm:type>
+      <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#unsignedLong">64720</tm:resourceData>
+    </tm:occurrence>
+  </tm:topic>
+
+  <tm:topic id="zauberlehrling">
+    <tm:subectIdentifier href="http://some.where/poem/Der_Zauberlehrling"/>
+    <tm:subectIdentifier href="http://some.where/poem/Zauberlehrling"/>
+    <tm:itemIdentity href="http://some.where/poem/Zauberlehrling_itemIdentity"/>
+    <tm:subjectLocator href="http://some.where/resource"/>
+    <tm:instanceOf><tm:topicRef href="#poem"/></tm:instanceOf>
+    <tm:occurrence>
+      <tm:type><tm:topicRef href="#title"/></tm:type>
+      <tm:scope>
+	<tm:topicRef href="#de"/>
+	<tm:topicRef href="#en"/>
+      </tm:scope>
+      <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string">Der Zauberlehrling</tm:resourceData>
+    </tm:occurrence>
+    <tm:occurrence>
+      <tm:type><tm:topicRef href="#content"/></tm:type>
+      <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string">Hat der alte Hexenmeister ...</tm:resourceData>
+    </tm:occurrence>
+  </tm:topic>
+
+  <tm:topic id="UUID-dateRange-1">
+    <tm:occurrence>
+      <tm:type><tm:topicRef href="#start"/></tm:type>
+      <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#date">01.01.1797</tm:resourceData>
+    </tm:occurrence>
+        <tm:occurrence>
+      <tm:type><tm:topicRef href="#end"/></tm:type>
+      <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#date">31.12.1797</tm:resourceData>
+    </tm:occurrence>
+  </tm:topic>
+
+  <tm:topic id="erlkoenig">
+    <tm:subjectIdentifier href="http://some.where/ballad/Der_Erlkoenig"/>
+    <tm:instanceOf><tm:topicRef href="#ballad"/></tm:instanceOf>
+    <tm:occurrence>
+      <tm:type><tm:topicRef href="#title"/></tm:type>
+      <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string">Der Erlk?nig</tm:resourceData>
+      <tm:scope><tm:topicRef href="#en"/></tm:scope>
+    </tm:occurrence>
+    <tm:occurrence>
+      <tm:type><tm:topicRef href="#content"/></tm:type>
+      <tm:scope><tm:topicRef href="#de"/></tm:scope>
+      <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string">Wer reitet so sp?t durch Nacht und Wind? ...</tm:resourceData>
+    </tm:occurrence>
+  </tm:topic>
+
+  <tm:topic id="UUID-dateRange-2">
+    <tm:occurrence>
+      <tm:type><tm:topicRef href="#start"/></tm:type>
+      <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#date">01.01.1782</tm:resourceData>
+    </tm:occurrence>
+        <tm:occurrence>
+      <tm:type><tm:topicRef href="#end"/></tm:type>
+      <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#date">31.12.1782</tm:resourceData>
+    </tm:occurrence>
+  </tm:topic>
+
+  <tm:topic id="prometheus">
+    <tm:subjectIdentifier href="http://some.where/ballad/Prometheus"/>
+    <tm:instanceOf><tm:topicRef href="#poem"/></tm:instanceOf>
+    <tm:occurrence>
+      <tm:type><tm:topicRef href="#title"/></tm:type>
+      <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string">Prometheus</tm:resourceData>
+      <tm:scope><tm:topicRef href="#de"/></tm:scope>
+    </tm:occurrence>
+    <tm:occurrence>
+      <tm:type><tm:topicRef href="#content"/></tm:type>
+      <tm:scope><tm:topicRef href="#de"/></tm:scope>
+      <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string"> Bedecke deinen Himmel, Zeus, ... </tm:resourceData>
+    </tm:occurrence>
+  </tm:topic>
+
+  <tm:topic id="UUID-dateRange-3">
+    <tm:occurrence>
+      <tm:type><tm:topicRef href="#start"/></tm:type>
+      <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#date">01.01.1772</tm:resourceData>
+    </tm:occurrence>
+        <tm:occurrence>
+      <tm:type><tm:topicRef href="#end"/></tm:type>
+      <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#date">31.12.1774</tm:resourceData>
+    </tm:occurrence>
+  </tm:topic>
+
+  <tm:topic id="dateRange">
+    <tm:subjectIdentifier href="http://some.where/relationship/dateRange"/>
+  </tm:topic>
+
+  <tm:topic id="officialese">
+    <tm:subjectIdentifier href="http://some.where/relationship/officialese"/>
+  </tm:topic>
+
+  <tm:topic id="content">
+    <tm:subjectIdentifier href="http://some.where/relationship/content"/>
+  </tm:topic>
+
+  <tm:topic id="start">
+    <tm:subjectIdentifier href="http://some.where/relationship/start"/>
+  </tm:topic>
+
+  <tm:topic id="end">
+    <tm:subjectIdentifier href="http://some.where/relationship/end"/>
+  </tm:topic>
+
+  <tm:topic id="de">
+    <tm:subjectIdentifier href="http://isidorus/rdf2tm_mapping/scope/de"/>
+  </tm:topic>
+
+  <tm:topic id="en">
+    <tm:subjectIdentifier href="http://some.where/scope/en"/>
+  </tm:topic>
+
+  <tm:topic id="title">
+    <tm:subjetcIdentifier href="http://some.where/relationship/title"/>
+  </tm:topic>
+
+  <tm:topic id="poem">
+    <tm:subjectIdentifier href="http://some.where/types/Poem"/>
+  </tm:topic>
+
+  <tm:topic id="ballad">
+    <tm:subjectIdentifier href="http://some.where/types/Ballad"/>
+  </tm:topic>
+
+  <tm:topic id="supertype-subtype">
+    <tm:subjectIdentifier href="http://psi.topicmaps.org/iso13250/model/supertype-subtype"/>
+  </tm:topic>
+
+  <tm:topic id="supertype">
+    <tm:subjectIdentifier href="http://psi.topicmaps.org/iso13250/model/supertype"/>
+  </tm:topic>
+
+  <tm:topic id="subtype">
+    <tm:subjectIdentifier href="http://psi.topicmaps.org/iso13250/model/subtype"/>
+  </tm:topic>
+
+  <tm:topic id="region">
+    <tm:subjectIdentifier href="http://some.where/types/Region"/>
+  </tm:topic>
+
+  <tm:topic id="city">
+    <tm:subjectIdentifier href="http://some.where/types/City"/>
+  </tm:topic>
+
+  <tm:topic id="died">
+    <tm:subjectIdentifier href="http://some.where/relationship/died"/>
+  </tm:topic>
+
+  <tm:topic id="capital">
+    <tm:subjectIdentifier href="http://some.where/relationship/capital"/>
+  </tm:topic>
+
+  <tm:topic id="german">
+    <tm:subjectIdentifier href="http://some.where/language/German"/>
+    <tm:instanceOf><tm:topicRef href="#language"/></tm:instanceOf>
+  </tm:topic>
+
+  <tm:topic id="language">
+    <tm:subjectIdentifier href="http://some.where/types/Language"/>
+  </tm:topic>
+
+  <tm:topic id="population">
+    <tm:subjectIdentifier href="http://some.where/relationship/population"/>
+  </tm:topic>
+
+  <tm:topic id="nativeName">
+    <tm:subjectIdentifier href="http://some.where/relationship/nativeName"/>
+  </tm:topic>
+
+  <tm:topic id="country">
+    <tm:subjectIdentifier href="http://some.where/types/Country"/>
+  </tm:topic>
+
+  <tm:topic id="metropolis">
+    <tm:subjectIdentifier href="http://some.where/types/Metropolis"/>
+  </tm:topic>
+
+  <tm:topic id="locatedIn">
+    <tm:subjectIdentifier href="http://some.where/relationship/locatedIn"/>
+  </tm:topic>
+
+  <tm:topic id="place">
+    <tm:subjectIdentifier href="http://some.where/relationship/place"/>
+  </tm:topic>
+
+  <tm:topic id="fullName">
+    <tm:subjectIdentifier href="http://some.where/relationship/fullName"/>
+  </tm:topic>
+
+  <tm:topic id="date">
+    <tm:subjectIdentifier href="http://some.where/relationship/date"/>
+  </tm:topic>
+
+  <tm:topic id="born">
+    <tm:subjectIdentifier href="http://some.where/relationship/born"/>
+  </tm:topic>
+
+  <tm:topic id="author">
+    <tm:subjectIdentifier href="http://some.where/types/Author"/>
+  </tm:topic>
+
+  <tm:topic id="firstName">
+    <tm:subjectIdentifier href="http://some.where/relationship/firstName"/>
+  </tm:topic>
+
+  <tm:topic id="lastName">
+    <tm:subjectIdentifier href="http://some.where/relationsip/lastName"/>
+  </tm:topic>
+
+  <tm:topic id="event">
+    <tm:subjectIdentifier href="http://some.where/types/Event"/>
+  </tm:topic>
+
+  <tm:topic id="isi-subject">
+    <tm:subjectIdentifier href="http://isidorus/rdf2tm_mapping/subject"/>
+  </tm:topic>
+
+  <tm:topic id="isi-object">
+    <tm:subjectIdentifier href="http://isidorus/rdf2tm_mapping/object"/>
+  </tm:topic>
+
+  <tm:association>
+    <tm:type><tm:topicRef href="#born"/></tm:type>
+    <tm:role>
+      <tm:type><tm:topicRef href="#isi-subject"/></tm:type>
+      <tm:topicRef href="#goethe"/>
+    </tm:role>
+    <tm:role>
+      <tm:type><tm:topicRef href="#isi-object"/></tm:type>
+      <tm:topicRef href="#UUID-born-event"/>
+    </tm:role>
+  </tm:association>
+
+  <tm:association>
+    <tm:type><tm:topicRef href="#place"/></tm:type>
+    <tm:role>
+      <tm:type><tm:topicRef href="#isi-subject"/></tm:type>
+      <tm:topicRef href="#UUID-born-event"/>
+    </tm:role>
+    <tm:role>
+      <tm:type><tm:topicRef href="#isi-object"/></tm:type>
+      <tm:topicRef href="#frankfurt_m"/>
+    </tm:role>
+  </tm:association>
+
+  <tm:association>
+    <tm:type><tm:topicRef href="#locatedIn"/></tm:type>
+    <tm:role>
+      <tm:type><tm:topicRef href="#isi-subject"/></tm:type>
+      <tm:topicRef href="#frankfurt_m"/>
+    </tm:role>
+    <tm:role>
+      <tm:type><tm:topicRef href="#isi-object"/></tm:type>
+      <tm:topicRef href="#germany"/>
+    </tm:role>
+  </tm:association>
+
+  <tm:association>
+    <tm:type><tm:topicRef href="#officialese"/></tm:type>
+    <tm:role>
+      <tm:type><tm:topicRef href="#isi-subject"/></tm:type>
+      <tm:topicRef href="#germany"/>
+    </tm:role>
+    <tm:role>
+      <tm:type><tm:topicRef href="#isi-object"/></tm:type>
+      <tm:topicRef href="#german"/>
+    </tm:role>
+  </tm:association>
+
+  <tm:association>
+    <tm:type><tm:topicRef href="#locatedIn"/></tm:type>
+    <tm:role>
+      <tm:type><tm:topicRef href="#isi-subject"/></tm:type>
+      <tm:topicRef href="#berlin"/>
+    </tm:role>
+    <tm:role>
+      <tm:type><tm:topicRef href="#isi-object"/></tm:type>
+      <tm:topicRef href="#germany"/>
+    </tm:role>
+  </tm:association>
+
+  <tm:association>
+    <tm:type><tm:topicRef href="#capital"/></tm:type>
+    <tm:role>
+      <tm:type><tm:topicRef href="#isi-subject"/></tm:type>
+      <tm:topicRef href="#germany"/>
+    </tm:role>
+    <tm:role>
+      <tm:type><tm:topicRef href="#isi-object"/></tm:type>
+      <tm:topicRef href="#berlin"/>
+    </tm:role>
+  </tm:association>
+
+  <tm:association>
+    <tm:type><tm:topicRef href="#died"/></tm:type>
+    <tm:role>
+      <tm:type><tm:topicRef href="#isi-subject"/></tm:type>
+      <tm:topicRef href="#goethe"/>
+    </tm:role>
+    <tm:role>
+      <tm:type><tm:topicRef href="#isi-object"/></tm:type>
+      <tm:topicRef href="#UUID-died-event"/>
+    </tm:role>
+  </tm:association>
+
+  <tm:association>
+    <tm:type><tm:topicRef href="#place"/></tm:type>
+    <tm:role>
+      <tm:type><tm:topicRef href="#isi-subject"/></tm:type>
+      <tm:topicRef href="#UUID-died-event"/>
+    </tm:role>
+    <tm:role>
+      <tm:type><tm:topicRef href="#isi-object"/></tm:type>
+      <tm:topicRef href="#weimar"/>
+    </tm:role>
+  </tm:association>
+
+  <tm:association>
+    <tm:type><tm:topicRef href="#locatedIn"/></tm:type>
+    <tm:role>
+      <tm:type><tm:topicRef href="#isi-subject"/></tm:type>
+      <tm:topicRef href="#weimar"/>
+    </tm:role>
+    <tm:role>
+      <tm:type><tm:topicRef href="#isi-object"/></tm:type>
+      <tm:topicRef href="#germany"/>
+    </tm:role>
+  </tm:association>
+
+  <tm:association>
+    <tm:type><tm:topicRef href="#supertype-subtype"/></tm:type>
+    <tm:role>
+      <tm:type><tm:topicRef href="#supertype"/></tm:type>
+      <tm:topicRef href="#region"/>
+    </tm:role>
+    <tm:role>
+      <tm:type><tm:topicRef href="#subtype"/></tm:type>
+      <tm:topicRef href="#city"/>
+    </tm:role>
+  </tm:association>
+
+  <tm:association>
+    <tm:itemIdentity href="http://some.where/metropolis_supertye-subtype-association"/>
+    <tm:type><tm:topicRef href="#supertype-subtype"/></tm:type>
+    <tm:role>
+      <tm:type><tm:topicRef href="#supertype"/></tm:type>
+      <tm:topicRef href="#region"/>
+    </tm:role>
+    <tm:role>
+      <tm:type><tm:topicRef href="#subtype"/></tm:type>
+      <tm:topicRef href="#metropolis"/>
+    </tm:role>
+  </tm:association>
+
+  <tm:association>
+    <tm:type><tm:topicRef href="#dateRange"/></tm:type>
+    <tm:role>
+      <tm:type><tm:topicRef href="#isi-subject"/></tm:type>
+      <tm:topicRef href="#zauberlehrling"/>
+    </tm:role>
+    <tm:role>
+      <tm:type><tm:topicRef href="#isi-object"/></tm:type>
+      <tm:topicRef href="#UUID-dateRange-1"/>
+    </tm:role>
+  </tm:association>
+
+  <tm:association>
+    <tm:type><tm:topicRef href="#dateRange"/></tm:type>
+    <tm:role>
+      <tm:type><tm:topicRef href="#isi-subject"/></tm:type>
+      <tm:topicRef href="#erlkoenig"/>
+    </tm:role>
+    <tm:role>
+      <tm:type><tm:topicRef href="#isi-object"/></tm:type>
+      <tm:topicRef href="#UUID-dateRange-2"/>
+    </tm:role>
+  </tm:association>
+
+  <tm:association>
+    <tm:type><tm:topicRef href="#dateRange"/></tm:type>
+    <tm:role>
+      <tm:type><tm:topicRef href="#isi-subject"/></tm:type>
+      <tm:topicRef href="#prometheus"/>
+    </tm:role>
+    <tm:role>
+      <tm:type><tm:topicRef href="#isi-object"/></tm:type>
+      <tm:topicRef href="#UUID-dateRange-3"/>
+    </tm:role>
+  </tm:association>
+
+  <!-- the rdf:li elements are contained as a collection, to test the export
+       of collections -->
+  <tm:topic id="wrote">
+    <tm:subjectIdentifier href="http://some.where/relationship/wrote"/>
+  </tm:topic>
+
+  <tm:topic id="rest">
+    <tm:subjectIdentifier href="http://www.w3.org/1999/02/22-rdf-syntax-ns#rest"/>
+  </tm:topic>
+
+  <tm:topic id="first">
+    <tm:subjectIdentifier href="http://www.w3.org/1999/02/22-rdf-syntax-ns#first"/>
+  </tm:topic>
+
+  <tm:topic id="nil">
+    <tm:subjectIdentifier href="http://www.w3.org/1999/02/22-rdf-syntax-ns#nil"/>
+  </tm:topic>
+
+  <!-- first node -->
+  <tm:topic id="UUID-1-collection"/>
+  
+  <tm:association>
+    <tm:type><tm:topicRef href="#wrote"/></tm:type>
+    <tm:role>
+      <tm:type><tm:topicRef href="#isi-subject"/></tm:type>
+      <tm:topicRef href="#goethe"/>
+    </tm:role>
+    <tm:role>
+      <tm:type><tm:topicRef href="#isi-object"/></tm:type>
+      <tm:topicRef href="#UUID-1-collection"/>
+    </tm:role>
+  </tm:association>
+
+  <tm:association>
+    <tm:type><tm:topicRef href="#first"/></tm:type>
+    <tm:role>
+      <tm:type><tm:topicRef href="#isi-subject"/></tm:type>
+      <tm:topicRef href="#UUID-1-collection"/>
+    </tm:role>
+    <tm:role>
+      <tm:type><tm:topicRef href="#isi-object"/></tm:type>
+      <tm:topicRef href="#zauberlehrling"/>
+    </tm:role>
+  </tm:association>
+
+  <tm:association>
+    <tm:type><tm:topicRef href="#rest"/></tm:type>
+    <tm:role>
+      <tm:type><tm:topicRef href="#isi-subject"/></tm:type>
+      <tm:topicRef href="#UUID-1-collection"/>
+    </tm:role>
+    <tm:role>
+      <tm:type><tm:topicRef href="#isi-object"/></tm:type>
+      <tm:topicRef href="#UUID-2-collection"/>
+    </tm:role>
+  </tm:association>
+  
+  <!-- second node -->
+  <tm:topic id="UUID-2-collection"/>
+
+  <tm:association>
+    <tm:type><tm:topicRef href="#first"/></tm:type>
+    <tm:role>
+      <tm:type><tm:topicRef href="#isi-subject"/></tm:type>
+      <tm:topicRef href="#UUID-2-collection"/>
+    </tm:role>
+    <tm:role>
+      <tm:type><tm:topicRef href="#isi-object"/></tm:type>
+      <tm:topicRef href="#erlkoenig"/>
+    </tm:role>
+  </tm:association>
+
+  <tm:association>
+    <tm:type><tm:topicRef href="#rest"/></tm:type>
+    <tm:role>
+      <tm:type><tm:topicRef href="#isi-subject"/></tm:type>
+      <tm:topicRef href="#UUID-2-collection"/>
+    </tm:role>
+    <tm:role>
+      <tm:type><tm:topicRef href="#isi-object"/></tm:type>
+      <tm:topicRef href="#UUID-3-collection"/>
+    </tm:role>
+  </tm:association>
+
+  <!-- third node -->
+  <tm:topic id="UUID-3-collection"/>
+
+  <tm:association>
+    <tm:type><tm:topicRef href="#first"/></tm:type>
+    <tm:role>
+      <tm:type><tm:topicRef href="#isi-subject"/></tm:type>
+      <tm:topicRef href="#UUID-3-collection"/>
+    </tm:role>
+    <tm:role>
+      <tm:type><tm:topicRef href="#isi-object"/></tm:type>
+      <tm:topicRef href="#prometheus"/>
+    </tm:role>
+  </tm:association>
+
+  <tm:association>
+    <tm:type><tm:topicRef href="#rest"/></tm:type>
+    <tm:role>
+      <tm:type><tm:topicRef href="#isi-subject"/></tm:type>
+      <tm:topicRef href="#UUID-3-collection"/>
+    </tm:role>
+    <tm:role>
+      <tm:type><tm:topicRef href="#isi-object"/></tm:type>
+      <tm:topicRef href="#nil"/>
+    </tm:role>
+  </tm:association>
+</tm:topicMap>
\ No newline at end of file

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 24 12:37:40 2009
@@ -1793,7 +1793,7 @@
 	  (prometheus "http://some.where/poem/Prometheus")
 	  (erlkoenig "http://some.where/ballad/Der_Erlkoenig")
 	  (date "http://www.w3.org/2001/XMLSchema#date")
-	  (de (d:get-item-by-id "http://isidorus/rdf2tm_mapping/scope#de"))
+	  (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 occs) 23))
@@ -1866,6 +1866,7 @@
 		       (string= (d:uri (first (d:psis (d:instance-of x))))
 				(concatenate 'string arcs "title"))
 		       (string= *xml-string* (d:datatype x))
+		       (string= (d:charvalue x) "Der Zauberlehrling")
 		       (= 1 (length (d:themes x)))
 		       (eql (first (d:themes x)) de)
 		       (= (length (d:psis (d:topic x))) 1)
@@ -1879,6 +1880,7 @@
 		       (string= (d:uri (first (d:psis (d:instance-of x))))
 				(concatenate 'string arcs "title"))
 		       (= 0 (length (d:themes x)))
+		       (string= (d:charvalue x) "Prometheus")
 		       (string= *xml-string* (d:datatype x))
 		       (= (length (d:psis (d:topic x))) 1)
 		       (string= (d:uri (first (d:psis (d:topic x))))
@@ -1891,6 +1893,7 @@
 		       (string= (d:uri (first (d:psis (d:instance-of x))))
 				(concatenate 'string arcs "title"))
 		       (string= *xml-string* (d:datatype x))
+		       (string= (d:charvalue x) "Der Erlk?nig")
 		       (= 1 (length (d:themes x)))
 		       (eql (first (d:themes x)) de)
 		       (= (length (d:psis (d:topic x))) 1)
@@ -1904,6 +1907,7 @@
 		       (string= (d:uri (first (d:psis (d:instance-of x))))
 				(concatenate 'string arcs "content"))
 		       (string= *xml-string* (d:datatype x))
+		       (string= (d:charvalue x) "Hat der alte Hexenmeister ...")
 		       (= 1 (length (d:themes x)))
 		       (eql (first (d:themes x)) de)
 		       (= (length (d:psis (d:topic x))) 1)
@@ -1917,6 +1921,8 @@
 		       (string= (d:uri (first (d:psis (d:instance-of x))))
 				(concatenate 'string arcs "content"))
 		       (string= *xml-string* (d:datatype x))
+		       (string= (d:charvalue x)
+				" Bedecke deinen Himmel, Zeus, ... ")
 		       (= 1 (length (d:themes x)))
 		       (eql (first (d:themes x)) de)
 		       (= (length (d:psis (d:topic x))) 1)
@@ -1930,6 +1936,8 @@
 		       (string= (d:uri (first (d:psis (d:instance-of x))))
 				(concatenate 'string arcs "content"))
 		       (string= *xml-string* (d:datatype x))
+		       (string= (d:charvalue x)
+				"Wer reitet so sp?t durch Nacht und Wind? ...")
 		       (= 1 (length (d:themes x)))
 		       (eql (first (d:themes x)) de)
 		       (= (length (d:psis (d:topic x))) 1)

Modified: trunk/src/xml/rdf/exporter.lisp
==============================================================================
--- trunk/src/xml/rdf/exporter.lisp	(original)
+++ trunk/src/xml/rdf/exporter.lisp	Mon Aug 24 12:37:40 2009
@@ -4,4 +4,245 @@
 ;;+
 ;;+  Isidorus is freely distributable under the LGPL license.
 ;;+  You can find a detailed description in trunk/docs/LGPL-LICENSE.txt.
-;;+-----------------------------------------------------------------------------
\ No newline at end of file
+;;+-----------------------------------------------------------------------------
+
+(defpackage :rdf-exporter
+  (:use :cl :cxml :elephant :datamodel :isidorus-threading :datamodel)
+  (:import-from :constants
+		*rdf-ns*
+		*rdfs-ns*
+		*xml-ns*
+		*xml-string*
+		*xml-uri*
+		*rdf2tm-ns*
+		*rdf2tm-object*
+		*rdf2tm-subject*
+		*rdf2tm-scope-prefix*
+		*tm2rdf-ns*)
+  (:import-from :isidorus-threading
+		with-reader-lock
+		with-writer-lock)
+  (:import-from :exporter
+		*export-tm*
+		export-to-elem)
+  (:export :export-rdf))
+
+(in-package :rdf-exporter)
+
+
+(defvar *ns-map* nil) ;; ((:prefix <string> :uri <string>))
+
+
+(defun export-rdf (rdf-path &key tm-id (revision (get-revision)))
+  "Exports the topoic map bound to tm-id as RDF."
+  (with-reader-lock
+    (let ((tm (when tm-id
+		(get-item-by-item-identifier tm-id :revision revision))))
+      (setf *ns-map* nil)
+      (setf *export-tm* tm)
+      (with-revision revision
+	(with-open-file (stream rdf-path :direction :output)
+	  (cxml:with-xml-output (cxml:make-character-stream-sink
+				 stream :canonical nil)
+	    (cxml:with-namespace ("isi" *tm2rdf-ns*)
+	      (cxml:with-namespace ("rdf" *rdf-ns*)
+		(cxml:with-namespace ("rdfs" *rdfs-ns*)
+		  (cxml:with-namespace ("xml" *xml-ns*)
+		    (cxml:with-element "rdf:RDF"
+		      (export-to-elem tm #'to-rdf-elem)))))))))))
+  (setf *ns-map* nil))
+
+
+(defun get-ns-prefix (ns-uri)
+  (let ((ns-entry
+	 (find-if #'(lambda(x)
+		      (string= (getf x :uri)
+			       ns-uri))
+		  *ns-map*)))
+    (if ns-entry
+	(getf ns-entry :prefix)
+	(let ((new-name (concatenate
+			 'string "ns"
+			 (write-to-string (+ 1 (length *ns-map*))))))
+	  (push (list :prefix new-name
+		      :uri ns-uri)
+		*ns-map*)
+	  new-name))))
+
+
+(defun separate-uri (uri)
+  (when (or (not uri)
+	    (= (length uri) 0)
+	    (and uri
+		 (> (length uri) 0)
+		 (or (eql (elt uri (- (length uri) 1)) #\#)
+		     (eql (elt uri (- (length uri) 1)) #\/)
+		     (eql (elt uri 0) #\#)
+		     (eql (elt uri 0) #\/))))
+    (error "From separate-uri(): bad ns-uri: ~a" uri))
+  (let ((pos-hash (position #\# uri :from-end t))
+	(pos-slash (position #\/ uri :from-end t)))
+    (unless (or pos-hash pos-slash)
+      (error "From separate-uri(): bad ns-uri: ~a" uri))
+    (if (not (or pos-hash pos-slash))
+	(list :prefix *tm2rdf-ns*
+	      :suffix uri)
+	(let ((prefix (subseq uri 0 (+ (max (or pos-hash 0) (or pos-slash 0)) 1)))
+	      (suffix (subseq uri (+ (max (or pos-hash 0) (or pos-slash 0)) 1))))
+	  (list :prefix prefix
+		:suffix suffix)))))
+
+
+(defun get-xml-lang (topic)
+  (declare (TopicC topic))
+  (when (xml-lang-p topic)
+    (subseq (uri (first (psis topic))) (length *rdf2tm-scope-prefix*))))
+
+
+(defun xml-lang-p (topic)
+  (declare (TopicC topic))
+  (when (= (length (psis topic)) 1)
+    (when (string-starts-with (uri (first (psis topic)))
+			      *rdf2tm-scope-prefix*)
+      t)))
+
+
+(defun make-topic-id (topic)
+  (declare (TopicC topic))
+  (concatenate 'string "id_" (write-to-string (elephant::oid topic))))
+
+
+(defun make-topic-reference (topic)
+  (declare (TopicC topic))
+  (if (psis topic)
+      (cxml:attribute "rdf:resource" (uri (first (psis topic))))
+      (cxml:attribute "rdf:nodeID" (make-topic-id topic))))
+		      
+
+
+(defgeneric to-rdf-elem (construct)
+  (:documentation "Exports Topic Maps Constructs as RDF. "))
+
+
+(defmethod to-rdf-elem ((construct PersistentIdC))
+  (cxml:with-element "isi:subjectIdentifier"
+    (cxml:attribute "rdf:datatype" *xml-uri*)
+    (cxml:text (uri construct))))
+
+
+(defmethod to-rdf-elem ((construct SubjectLocatorC))
+  (cxml:with-element "isi:subjectLocator"
+    (cxml:attribute "rdf:datatype" *xml-uri*)
+    (cxml:text (uri construct))))
+
+
+(defmethod to-rdf-elem ((construct ItemIdentifierC))
+  (cxml:with-element "isi:itemIdentity"
+    (cxml:attribute "rdf:datatype" *xml-uri*)
+    (cxml:text (uri construct))))
+
+
+(defun scopes-to-rdf-elems (owner-construct)
+  (declare ((or AssociationC OccurrenceC NameC VariantC RoleC) owner-construct))
+  (map 'list #'(lambda(x)
+		 (cxml:with-element "isi:scope"
+		   (make-topic-reference x)))
+       (themes owner-construct)))
+
+
+(defun resourceX-to-rdf-elem (owner-construct)
+  (declare ((or OccurrenceC VariantC) owner-construct))
+  (cxml:with-element "isi:value"
+    (cxml:attribute "rdf:datatype" (datatype owner-construct))
+    (cxml:text (charvalue owner-construct))))
+
+
+(defmethod to-rdf-elem ((construct VariantC))
+  (cxml:with-element "isi:variant"
+    (cxml:attribute "rdf:parseType" "Resource")
+    (map 'list #'to-rdf-elem (item-identifiers construct))
+    (scopes-to-rdf-elems construct)
+    (resourceX-to-rdf-elem construct)))
+
+
+(defmethod to-rdf-elem ((construct NameC))
+  (cxml:with-element "isi:name"
+    (cxml:attribute "rdf:parseType" "Resource")
+    (map 'list #'to-rdf-elem (item-identifiers construct))
+    (cxml:with-element "isi:nametype"
+      (make-topic-reference (instance-of construct)))
+    (scopes-to-rdf-elems construct)
+    (cxml:with-element "isi:value"
+      (cxml:attribute "rdf:datatype" *xml-string*)
+      (cxml:text (charvalue construct)))
+    (map 'list #'to-rdf-elem (variants construct))))
+
+
+(defmethod to-rdf-elem ((construct OccurrenceC))
+  (let ((scopes (when (themes construct)
+		  (loop for theme in (themes construct)
+		     when (not (xml-lang-p theme))
+		     collect theme))))
+    (if (or scopes
+	    (item-identifiers construct)
+	    (/= (length (psis (instance-of construct))) 1))
+	(cxml:with-element "isi:occurrence"
+	  (cxml:attribute "rdf:parseType" "Resource")
+	  (map 'list #'to-rdf-elem (item-identifiers construct))
+	  (cxml:with-element "isi:occurrencetype"
+	    (make-topic-reference (instance-of construct)))
+	  (scopes-to-rdf-elems construct)
+	  (resourceX-to-rdf-elem construct))
+	(let ((ns-list
+	       (separate-uri (uri (first (psis (instance-of construct)))))))
+	  (let ((ns (getf ns-list :prefix))
+		(tag-name (getf ns-list :suffix)))
+	    (cxml:with-namespace ((get-ns-prefix ns) ns)
+	      (cxml:with-element (concatenate 'string (get-ns-prefix ns)
+					      ":" tag-name)
+		(cxml:attribute "rdf:datatype" (datatype construct))
+		(when (themes construct)
+		  (cxml:attribute "xml:lang" (get-xml-lang
+					      (first (themes construct)))))
+		(cxml:text (charvalue construct)))))))))
+
+
+(defmethod to-rdf-elem ((construct TopicC))
+  ;TODO: what's with used-as-player and core-topics
+  (format t "--> ~a " (if (psis construct)
+			  (uri (first (psis construct)))
+			  (make-topic-id construct)))
+  (if (and (not (or (> (length (psis construct)) 1)
+		    (item-identifiers construct)
+		    (locators construct)
+		    (names construct)
+		    (occurrences construct)))
+	   (or (used-as-type construct)
+	       (used-as-theme construct)))
+      nil ;; do not export this topic explicitly, since it is exported as
+          ;; rdf:resource, rdf:about or any other reference
+      (cxml:with-element "rdf:Description"
+	(let ((psi (when (psis construct)
+		     (first (psis construct)))))
+	  (if psi
+	      (cxml:attribute "rdf:about" (uri psi))
+	      (cxml:attribute "rdf:nodeID" (make-topic-id construct)))
+	  (map 'list #'to-rdf-elem (remove psi (psis construct)))
+	  (map 'list #'to-rdf-elem (locators construct))
+	  (map 'list #'to-rdf-elem (item-identifiers construct))
+	  (map 'list #'(lambda(x)
+			 (cxml:with-element "rdf:type"
+			   (make-topic-reference x)))
+	       (list-instanceOf construct))
+	  (map 'list #'(lambda(x)
+			 (cxml:with-element "rdfs:subClassOf"
+			   (make-topic-reference x)))
+	       (list-super-types construct))
+	  (map 'list #'to-rdf-elem (names construct))
+	  (map 'list #'to-rdf-elem (occurrences construct)))))
+  (format t "<--~%"))
+  
+
+(defmethod to-rdf-elem ((construct AssociationC))
+  ;TODO: check if the association has to be exported or not
+  )
\ 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	Mon Aug 24 12:37:40 2009
@@ -589,7 +589,7 @@
 (defun get-literals-of-node-content (node tm-id xml-base xml-lang)
   "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-content")
+  (tm-id-p tm-id "get-literals-of-noode-content")
   (let ((properties (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)))
@@ -607,7 +607,8 @@
 					   property nil))
 			   (prop-content (child-nodes-or-text property)))
 		       (and (or datatype
-				(string= parseType "Literal")
+				(and parseType
+				     (string= parseType "Literal"))
 				(and (not (or nodeID resource UUID parseType))
 				     (or (not prop-content)
 					 (stringp prop-content))))

Modified: trunk/src/xml/rdf/rdf_core_psis.xtm
==============================================================================
--- trunk/src/xml/rdf/rdf_core_psis.xtm	(original)
+++ trunk/src/xml/rdf/rdf_core_psis.xtm	Mon Aug 24 12:37:40 2009
@@ -11,14 +11,14 @@
 <topicMap xmlns="http://www.topicmaps.org/xtm/" version="2.0">
 
   <topic id="subject">
-    <subjectIdentifier href="http://isidorus/rdf2tm_mapping#subject"/>
+    <subjectIdentifier href="http://isidorus/rdf2tm_mapping/subject"/>
     <name>
       <value>subject</value>
     </name>
   </topic>
 
   <topic id="object">
-    <subjectIdentifier href="http://isidorus/rdf2tm_mapping#object"/>
+    <subjectIdentifier href="http://isidorus/rdf2tm_mapping/object"/>
     <name>
       <value>object</value>
     </name>

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 24 12:37:40 2009
@@ -33,8 +33,7 @@
 		*rdf-rest*
 		*rdf2tm-scope-prefix*)
   (:import-from :xml-constants
-		*rdf_core_psis.xtm*)
-  (:import-from :xml-constants
+		*rdf_core_psis.xtm*
 		*core_psis.xtm*)
   (:import-from :xml-tools
                 get-attribute
@@ -306,7 +305,6 @@
     (when (and (string= property-ns *rdf-ns*)
 	       (string= property-name "li"))
       (set-_n-name owner-identifier property)))
-      ;(set-_n-name property _n-counter)))
   t)
 
 
@@ -371,6 +369,7 @@
 	     datatype))
     (when (and (or nodeID resource)
 	       (> (length content) 0))
+      ;(set-_n-name property _n-counter)))
       (error "~awhen ~a is set no content is allowed: ~a!"
 	     err-pref
 	     (cond
@@ -428,7 +427,6 @@
    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))
     (when (get-ns-attribute node "li")
       (dom:map-node-map
        #'(lambda(attr)



From lgiessmann at common-lisp.net  Tue Aug 25 09:55:29 2009
From: lgiessmann at common-lisp.net (Lukas Giessmann)
Date: Tue, 25 Aug 2009 05:55:29 -0400
Subject: [isidorus-cvs] r118 - in trunk/src: unit_tests xml/rdf
Message-ID: <E1MfskT-000361-Rp@common-lisp.net>

Author: lgiessmann
Date: Tue Aug 25 05:55:29 2009
New Revision: 118

Log:
rdf-exporter: added functions/methods to the exporter module, thus exporting associations is also possible; added the types isi:name, isi:occurrence, isi:role and isi:name for the exported and mapped constructs.

Modified:
   trunk/src/unit_tests/poems_light.xtm
   trunk/src/xml/rdf/exporter.lisp

Modified: trunk/src/unit_tests/poems_light.xtm
==============================================================================
--- trunk/src/unit_tests/poems_light.xtm	(original)
+++ trunk/src/unit_tests/poems_light.xtm	Tue Aug 25 05:55:29 2009
@@ -1,9 +1,10 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <tm:topicMap version="2.0" xmlns:tm="http://www.topicmaps.org/xtm/">
   <!-- this file contains constructs that are originally defined as TM and
-       RDF, so certain constructs are not consistent because of test cases -->
+       RDF. So certain constructs are not consistent because of test cases,
+       but all are valid! -->
   <tm:topic id="goethe">
-    <tm:subjectIdentifier href="http://some.where/author/Goehte"/>
+    <tm:subjectIdentifier href="http://some.where/author/Goethe"/>
     <tm:instanceOf><tm:topicRef href="#author"/></tm:instanceOf>
     <tm:name>
       <tm:type><tm:topicRef href="#firstName"/></tm:type>
@@ -77,10 +78,12 @@
   </tm:topic>
 
   <tm:topic id="zauberlehrling">
-    <tm:subectIdentifier href="http://some.where/poem/Der_Zauberlehrling"/>
-    <tm:subectIdentifier href="http://some.where/poem/Zauberlehrling"/>
-    <tm:itemIdentity href="http://some.where/poem/Zauberlehrling_itemIdentity"/>
-    <tm:subjectLocator href="http://some.where/resource"/>
+    <tm:subjectIdentifier href="http://some.where/poem/Der_Zauberlehrling"/>
+    <tm:subjectIdentifier href="http://some.where/poem/Zauberlehrling"/>
+    <tm:itemIdentity href="http://some.where/poem/Zauberlehrling_itemIdentity_1"/>
+    <tm:itemIdentity href="http://some.where/poem/Zauberlehrling_itemIdentity_2"/>
+    <tm:subjectLocator href="http://some.where/resource_1"/>
+    <tm:subjectLocator href="http://some.where/resource_2"/>
     <tm:instanceOf><tm:topicRef href="#poem"/></tm:instanceOf>
     <tm:occurrence>
       <tm:type><tm:topicRef href="#title"/></tm:type>
@@ -188,7 +191,7 @@
   </tm:topic>
 
   <tm:topic id="title">
-    <tm:subjetcIdentifier href="http://some.where/relationship/title"/>
+    <tm:subjectIdentifier href="http://some.where/relationship/title"/>
   </tm:topic>
 
   <tm:topic id="poem">
@@ -465,8 +468,8 @@
     </tm:role>
   </tm:association>
 
-  <!-- the rdf:li elements are contained as a collection, to test the export
-       of collections -->
+  <!-- === the rdf:li elements are contained as a collection, to test the
+       export of collections =============================================== -->
   <tm:topic id="wrote">
     <tm:subjectIdentifier href="http://some.where/relationship/wrote"/>
   </tm:topic>
@@ -575,4 +578,58 @@
       <tm:topicRef href="#nil"/>
     </tm:role>
   </tm:association>
-</tm:topicMap>
\ No newline at end of file
+
+  <!-- === tests some TM associations that owns mor than two roles ========= -->
+  <tm:topic id="authorInfo">
+    <tm:subjectIdentifier href="http://some.where/relationship/authorInfo"/>
+  </tm:topic>
+
+  <tm:topic id="schiller">
+    <tm:instanceOf><tm:topicRef href="#author"/></tm:instanceOf>
+    <tm:name>
+      <tm:type><tm:topicRef href="#firstName"/></tm:type>
+      <tm:value>Johann Christoph Friedrich</tm:value>
+    </tm:name>
+    <tm:name>
+      <tm:type><tm:topicRef href="#lastName"/></tm:type>
+      <tm:value>von Schiller</tm:value>
+    </tm:name>
+    <tm:occurrence>
+      <tm:type><tm:topicRef href="#authorInfo"/></tm:type>
+      <tm:resourceRef href="http://de.wikipedia.org/wiki/Schiller"/>
+    </tm:occurrence>
+  </tm:topic>
+
+  <tm:topic id="associatedWithEachOther">
+    <tm:subjectIdentifier href="http://some.where/relationship/associatedWithEachOther"/>
+  </tm:topic>
+
+  <tm:topic id="writer">
+    <tm:subjectIdentifier href="http://some.where/roletype/writer"/>
+  </tm:topic>
+
+  <tm:topic id="literature">
+    <tm:subjectIdentifier href="http://some.where/roletype/literature"/>
+  </tm:topic>
+  
+  <tm:association>
+    <tm:itemIdentity href="http://some.where/test-association"/>
+    <tm:type><tm:topicRef href="#associatedWithEachOther"/></tm:type>
+    <tm:role>
+      <tm:type><tm:topicRef href="#writer"/></tm:type>
+      <tm:topicRef href="#schiller"/>
+    </tm:role>
+    <tm:role>
+      <tm:type><tm:topicRef href="#writer"/></tm:type>
+      <tm:topicRef href="#goethe"/>
+    </tm:role>
+    <tm:role>
+      <tm:type><tm:topicRef href="#literature"/></tm:type>
+      <tm:topicRef href="#poem"/>
+    </tm:role>
+    <tm:role>
+      <tm:type><tm:topicRef href="#literature"/></tm:type>
+      <tm:topicRef href="#ballad"/>
+    </tm:role>
+  </tm:association>
+</tm:topicMap>

Modified: trunk/src/xml/rdf/exporter.lisp
==============================================================================
--- trunk/src/xml/rdf/exporter.lisp	(original)
+++ trunk/src/xml/rdf/exporter.lisp	Tue Aug 25 05:55:29 2009
@@ -18,7 +18,9 @@
 		*rdf2tm-object*
 		*rdf2tm-subject*
 		*rdf2tm-scope-prefix*
-		*tm2rdf-ns*)
+		*tm2rdf-ns*
+		*type-instance-psi*
+		*supertype-subtype-psi*)
   (:import-from :isidorus-threading
 		with-reader-lock
 		with-writer-lock)
@@ -53,7 +55,19 @@
   (setf *ns-map* nil))
 
 
+(defun make-isi-type (type)
+  "Creates a rdf:type property with the URL-prefix of *tm2rdf-ns*."
+  (declare (string type))
+  (cxml:with-element "rdf:type"
+    (cxml:attribute "rdf:resource" (concatenate 'string *tm2rdf-ns* type))))
+
+
 (defun get-ns-prefix (ns-uri)
+  "Returns a namespace prefix of the form ns<integer>
+   that is given for a name space during serialization.
+   This mechanism is needed, since relations in RDF have
+   a variable tag name and namespace, so this function
+   uses the namespace map *ns-map*."
   (let ((ns-entry
 	 (find-if #'(lambda(x)
 		      (string= (getf x :uri)
@@ -71,6 +85,9 @@
 
 
 (defun separate-uri (uri)
+  "Returns a plist of the form (:prefix <string> :suffix <string>)
+   that contains the prefix part of the passed uri and the suffix
+   part separated by a '/' or '#'."
   (when (or (not uri)
 	    (= (length uri) 0)
 	    (and uri
@@ -100,6 +117,9 @@
 
 
 (defun xml-lang-p (topic)
+  "Returns t if the topic was an imported xml:lang attribute
+   of RDF/XML. This is the case if the topic has exactly one PSI
+   with the uri-prefix *rdf2tm-scope-prefix*."
   (declare (TopicC topic))
   (when (= (length (psis topic)) 1)
     (when (string-starts-with (uri (first (psis topic)))
@@ -107,16 +127,19 @@
       t)))
 
 
-(defun make-topic-id (topic)
-  (declare (TopicC topic))
-  (concatenate 'string "id_" (write-to-string (elephant::oid topic))))
+(defun make-object-id (object)
+  "Returns a string of the form id_<integer> which can be used
+   as nodeID."
+  (concatenate 'string "id_" (write-to-string (elephant::oid object))))
 
 
 (defun make-topic-reference (topic)
+  "Creates a topic refenrence by using the attributes rdf:resource
+   or rdf:nodeID, this depends on the PSIS of the topic."
   (declare (TopicC topic))
   (if (psis topic)
       (cxml:attribute "rdf:resource" (uri (first (psis topic))))
-      (cxml:attribute "rdf:nodeID" (make-topic-id topic))))
+      (cxml:attribute "rdf:nodeID" (make-object-id topic))))
 		      
 
 
@@ -125,24 +148,29 @@
 
 
 (defmethod to-rdf-elem ((construct PersistentIdC))
+  "Creates a property which described a PSI."
   (cxml:with-element "isi:subjectIdentifier"
     (cxml:attribute "rdf:datatype" *xml-uri*)
     (cxml:text (uri construct))))
 
 
 (defmethod to-rdf-elem ((construct SubjectLocatorC))
+  "Creates a property which describes a subjectLocator."
   (cxml:with-element "isi:subjectLocator"
     (cxml:attribute "rdf:datatype" *xml-uri*)
     (cxml:text (uri construct))))
 
 
 (defmethod to-rdf-elem ((construct ItemIdentifierC))
+  "Creates a property which creates an itemIdentifier."
   (cxml:with-element "isi:itemIdentity"
     (cxml:attribute "rdf:datatype" *xml-uri*)
     (cxml:text (uri construct))))
 
 
 (defun scopes-to-rdf-elems (owner-construct)
+  "Creates a set of properties. Everyone contains a reference to
+   a scope topic."
   (declare ((or AssociationC OccurrenceC NameC VariantC RoleC) owner-construct))
   (map 'list #'(lambda(x)
 		 (cxml:with-element "isi:scope"
@@ -151,6 +179,8 @@
 
 
 (defun resourceX-to-rdf-elem (owner-construct)
+  "Creates a property that contains a literal value and a datatype
+   depending on occurrences or variants."
   (declare ((or OccurrenceC VariantC) owner-construct))
   (cxml:with-element "isi:value"
     (cxml:attribute "rdf:datatype" (datatype owner-construct))
@@ -158,6 +188,8 @@
 
 
 (defmethod to-rdf-elem ((construct VariantC))
+  "Creates a blank node that represents a VariantC element with the
+   properties itemIdentity, scope and value."
   (cxml:with-element "isi:variant"
     (cxml:attribute "rdf:parseType" "Resource")
     (map 'list #'to-rdf-elem (item-identifiers construct))
@@ -166,8 +198,11 @@
 
 
 (defmethod to-rdf-elem ((construct NameC))
+  "Creates a blank node that represents a name element with the
+   properties itemIdentity, nametype, value, variant and scope."
   (cxml:with-element "isi:name"
     (cxml:attribute "rdf:parseType" "Resource")
+    (make-isi-type "name")
     (map 'list #'to-rdf-elem (item-identifiers construct))
     (cxml:with-element "isi:nametype"
       (make-topic-reference (instance-of construct)))
@@ -179,6 +214,8 @@
 
 
 (defmethod to-rdf-elem ((construct OccurrenceC))
+  "Creates a blank node that represents an occurrence element with the
+   properties itemIdentity, occurrencetype, value and scope."
   (let ((scopes (when (themes construct)
 		  (loop for theme in (themes construct)
 		     when (not (xml-lang-p theme))
@@ -188,6 +225,7 @@
 	    (/= (length (psis (instance-of construct))) 1))
 	(cxml:with-element "isi:occurrence"
 	  (cxml:attribute "rdf:parseType" "Resource")
+	  (make-isi-type "occurrence")
 	  (map 'list #'to-rdf-elem (item-identifiers construct))
 	  (cxml:with-element "isi:occurrencetype"
 	    (make-topic-reference (instance-of construct)))
@@ -208,25 +246,23 @@
 
 
 (defmethod to-rdf-elem ((construct TopicC))
-  ;TODO: what's with used-as-player and core-topics
-  (format t "--> ~a " (if (psis construct)
-			  (uri (first (psis construct)))
-			  (make-topic-id construct)))
+  "Creates a node that describes a TM topic."
   (if (and (not (or (> (length (psis construct)) 1)
 		    (item-identifiers construct)
 		    (locators construct)
 		    (names construct)
 		    (occurrences construct)))
 	   (or (used-as-type construct)
-	       (used-as-theme construct)))
-      nil ;; do not export this topic explicitly, since it is exported as
+	       (used-as-theme construct)
+	       (player-in-roles construct)))
+      nil ;; do not export this topic explicitly, since it has been exported as
           ;; rdf:resource, rdf:about or any other reference
       (cxml:with-element "rdf:Description"
 	(let ((psi (when (psis construct)
 		     (first (psis construct)))))
 	  (if psi
 	      (cxml:attribute "rdf:about" (uri psi))
-	      (cxml:attribute "rdf:nodeID" (make-topic-id construct)))
+	      (cxml:attribute "rdf:nodeID" (make-object-id construct)))
 	  (map 'list #'to-rdf-elem (remove psi (psis construct)))
 	  (map 'list #'to-rdf-elem (locators construct))
 	  (map 'list #'to-rdf-elem (item-identifiers construct))
@@ -239,10 +275,98 @@
 			   (make-topic-reference x)))
 	       (list-super-types construct))
 	  (map 'list #'to-rdf-elem (names construct))
-	  (map 'list #'to-rdf-elem (occurrences construct)))))
-  (format t "<--~%"))
+	  (map 'list #'to-rdf-elem (occurrences construct))))))
   
 
 (defmethod to-rdf-elem ((construct AssociationC))
-  ;TODO: check if the association has to be exported or not
-  )
\ No newline at end of file
+  "Exports association elements as RDF properties."
+  (let ((type-instance (get-item-by-psi *type-instance-psi*))
+	(supertype-subtype (get-item-by-psi *supertype-subtype-psi*))
+	(association-type (instance-of construct)))
+    (if (or (eql type-instance association-type)
+	    (eql supertype-subtype association-type))
+	nil ;; do nothing, the association has been already exported
+	    ;; either as rdf:type or rdfs:subClassOf
+	(let ((isi-subject (get-item-by-psi *rdf2tm-subject*))
+	      (isi-object (get-item-by-psi *rdf2tm-object*))
+	      (association-roles (roles construct))
+	      (ii (item-identifiers construct))
+	      (scopes (themes construct)))
+	  (let ((subject-role (find-if #'(lambda(x)
+					   (eql isi-subject (instance-of x)))
+				       association-roles))
+		(object-role (find-if #'(lambda(x)
+					  (eql isi-object (instance-of x)))
+				      association-roles)))
+	    (if (and subject-role object-role (not ii) (not scopes)
+		     (= (length association-roles) 2))
+		(rdf-mapped-association-to-rdf-elem construct)
+		(tm-association-to-rdf-elem construct)))))))
+
+
+(defun tm-association-to-rdf-elem (association)
+  "Exports a TM association as an RDF resource with special
+   properties, that descirbes this association."
+  (declare (AssociationC association))
+  (let ((ii (item-identifiers association))
+	(association-type (instance-of association))
+	(association-roles (roles association)))
+    (cxml:with-element "rdf:Description" 
+      (cxml:attribute "rdf:nodeID" (make-object-id association))
+      (make-isi-type "association")
+      (cxml:with-element "isi:associationtype"
+	(make-topic-reference association-type))
+      (map 'list #'to-rdf-elem ii)
+      (scopes-to-rdf-elems association)
+      (map 'list #'to-rdf-elem association-roles))))
+
+
+(defmethod to-rdf-elem ((construct RoleC))
+  "Exports a TM role as RDF resource with the properties
+   isi:roletype, isi:itemIdentity and isi:player."
+  (let ((ii (item-identifiers construct))
+	(role-type (instance-of construct))
+	(player-top (player construct)))
+    (cxml:with-element "isi:role"
+      (cxml:attribute "rdf:parseType" "Resource")
+      (make-isi-type "role")
+      (map 'list #'to-rdf-elem ii)
+      (cxml:with-element "isi:roletype"
+	(make-topic-reference role-type))
+      (cxml:with-element "isi:player"
+	(make-topic-reference player-top)))))
+
+
+(defun rdf-mapped-association-to-rdf-elem (association)
+  "Exports an TM association as RDF that was imported from RDF.
+   This is indicated by the existence of exactly two roles. One
+   of the type isi:object, the other of the type isi:subject.
+   Scopes or itemIdentifiers are also forbidden."
+  (declare (AssociationC association))
+  (let ((isi-subject (get-item-by-psi *rdf2tm-subject*))
+	(isi-object (get-item-by-psi *rdf2tm-object*))
+	(association-roles (roles association)))
+    (let ((subject-role (find-if #'(lambda(x)
+				     (eql isi-subject (instance-of x)))
+				 association-roles))
+	  (object-role (find-if #'(lambda(x)
+				    (eql isi-object (instance-of x)))
+				association-roles)))
+      (when (and subject-role object-role
+		 (= (length association-roles) 2))
+	(cxml:with-element "rdf:Description"
+	  (let ((psi (when (psis (player subject-role))
+		       (first (psis (player subject-role))))))
+	    (if psi
+		(cxml:attribute "rdf:about" (uri psi))
+		(cxml:attribute "rdf:nodeID"
+				(make-object-id (player subject-role))))
+	    (let ((ns-list
+		   (separate-uri (uri
+				  (first (psis (instance-of association)))))))
+	      (let ((ns (getf ns-list :prefix))
+		    (tag-name (getf ns-list :suffix)))
+		(cxml:with-namespace ((get-ns-prefix ns) ns)
+		  (cxml:with-element (concatenate 'string (get-ns-prefix ns)
+						  ":" tag-name)
+		    (make-topic-reference (player object-role))))))))))))
\ No newline at end of file



From lgiessmann at common-lisp.net  Tue Aug 25 12:06:20 2009
From: lgiessmann at common-lisp.net (Lukas Giessmann)
Date: Tue, 25 Aug 2009 08:06:20 -0400
Subject: [isidorus-cvs] r119 - trunk/src/xml/rdf
Message-ID: <E1Mfun5-0006wQ-UE@common-lisp.net>

Author: lgiessmann
Date: Tue Aug 25 08:06:11 2009
New Revision: 119

Log:
rdf-exporter: added the type isi:topic that is used in nodes representing topics that owns more than one psis or item-identifiers, subject-locators, names and occurrences which are represented as isi:occurrence nodes

Modified:
   trunk/src/xml/rdf/exporter.lisp

Modified: trunk/src/xml/rdf/exporter.lisp
==============================================================================
--- trunk/src/xml/rdf/exporter.lisp	(original)
+++ trunk/src/xml/rdf/exporter.lisp	Tue Aug 25 08:06:11 2009
@@ -140,7 +140,21 @@
   (if (psis topic)
       (cxml:attribute "rdf:resource" (uri (first (psis topic))))
       (cxml:attribute "rdf:nodeID" (make-object-id topic))))
-		      
+
+
+(defun isi-occurrence-p (owner-topic)
+  "Returns t if the owner topic has an occurrence that will
+   be mapped to an RDF occurrence node and no an
+   usual RDF property."
+  (declare (TopicC owner-topic))
+  (loop for occ in (occurrences owner-topic)
+     when (let ((ii (item-identifiers occ))
+		(scopes (loop for scope in (themes occ)
+			   when (not (xml-lang-p scope))
+			   collect scope)))
+	    (or ii scopes
+		(> (length (themes occ)) 1)))
+     return t))
 
 
 (defgeneric to-rdf-elem (construct)
@@ -221,6 +235,7 @@
 		     when (not (xml-lang-p theme))
 		     collect theme))))
     (if (or scopes
+	    (> (length (themes construct)) 1)
 	    (item-identifiers construct)
 	    (/= (length (psis (instance-of construct))) 1))
 	(cxml:with-element "isi:occurrence"
@@ -259,13 +274,21 @@
           ;; rdf:resource, rdf:about or any other reference
       (cxml:with-element "rdf:Description"
 	(let ((psi (when (psis construct)
-		     (first (psis construct)))))
+		     (first (psis construct))))
+	      (ii (item-identifiers construct))
+	      (sl (locators construct))
+	      (t-names (names construct))
+	      (t-occs (occurrences construct)))
 	  (if psi
 	      (cxml:attribute "rdf:about" (uri psi))
 	      (cxml:attribute "rdf:nodeID" (make-object-id construct)))
+	  (when (or (> (length (psis construct)) 1)
+		    ii sl t-names
+		    (isi-occurrence-p construct))
+	    (make-isi-type "topic"))
 	  (map 'list #'to-rdf-elem (remove psi (psis construct)))
-	  (map 'list #'to-rdf-elem (locators construct))
-	  (map 'list #'to-rdf-elem (item-identifiers construct))
+	  (map 'list #'to-rdf-elem sl)
+	  (map 'list #'to-rdf-elem ii)
 	  (map 'list #'(lambda(x)
 			 (cxml:with-element "rdf:type"
 			   (make-topic-reference x)))
@@ -274,8 +297,8 @@
 			 (cxml:with-element "rdfs:subClassOf"
 			   (make-topic-reference x)))
 	       (list-super-types construct))
-	  (map 'list #'to-rdf-elem (names construct))
-	  (map 'list #'to-rdf-elem (occurrences construct))))))
+	  (map 'list #'to-rdf-elem t-names)
+	  (map 'list #'to-rdf-elem t-occs)))))
   
 
 (defmethod to-rdf-elem ((construct AssociationC))



From lgiessmann at common-lisp.net  Wed Aug 26 16:24:42 2009
From: lgiessmann at common-lisp.net (Lukas Giessmann)
Date: Wed, 26 Aug 2009 12:24:42 -0400
Subject: [isidorus-cvs] r120 - in trunk/src: . unit_tests xml/rdf
Message-ID: <E1MgLIg-0000bd-RV@common-lisp.net>

Author: lgiessmann
Date: Wed Aug 26 12:24:42 2009
New Revision: 120

Log:
rdf:exporter: added the macro with-property and some unit tests

Modified:
   trunk/src/isidorus.asd
   trunk/src/unit_tests/fixtures.lisp
   trunk/src/unit_tests/poems_light.xtm
   trunk/src/unit_tests/rdf_importer_test.lisp
   trunk/src/unit_tests/unittests-constants.lisp
   trunk/src/xml/rdf/exporter.lisp

Modified: trunk/src/isidorus.asd
==============================================================================
--- trunk/src/isidorus.asd	(original)
+++ trunk/src/isidorus.asd	Wed Aug 26 12:24:42 2009
@@ -138,6 +138,8 @@
 					    :depends-on ("fixtures"))
 				     (:file "threading_test")
 				     (:file "rdf_importer_test"
+					    :depends-on ("fixtures"))
+				     (:file "rdf_exporter_test"
 					    :depends-on ("fixtures")))
 			:depends-on ("atom"
                                      "constants"

Modified: trunk/src/unit_tests/fixtures.lisp
==============================================================================
--- trunk/src/unit_tests/fixtures.lisp	(original)
+++ trunk/src/unit_tests/fixtures.lisp	Wed Aug 26 12:24:42 2009
@@ -30,7 +30,7 @@
            :merge-test-db
 	   :set-up-test-db
 	   :tear-down-test-db
-	   
+	   :rdf-exporter-test-db
 	   :*TEST-TM*
 	   :*NOTIFICATIONBASE-TM*
 	   :*XTM-TM*
@@ -191,4 +191,23 @@
 				   :document-id document-id)
     (elephant:open-store (xml-importer:get-store-spec db-dir))
     (&body)
+    (tear-down-test-db)))
+
+
+(def-fixture rdf-exporter-test-db()
+  (let ((db-dir "data_base")
+	(tm-id "http://test-tm")
+	(document-id "doc-id")
+	(exported-file-path "./__out__.rdf"))
+    (clean-out-db db-dir)
+    (handler-case (delete-file exported-file-path)
+      (error () )) ;do nothing
+    (setf d:*current-xtm* document-id)
+    (setup-repository *poems_light.xtm* db-dir :tm-id tm-id
+		      :xtm-id document-id)
+    (elephant:open-store (xml-importer:get-store-spec db-dir))
+    (rdf-exporter:export-rdf exported-file-path :tm-id tm-id)
+    (&body)
+    (handler-case (delete-file exported-file-path)
+      (error () )) ;do nothing
     (tear-down-test-db)))
\ No newline at end of file

Modified: trunk/src/unit_tests/poems_light.xtm
==============================================================================
--- trunk/src/unit_tests/poems_light.xtm	(original)
+++ trunk/src/unit_tests/poems_light.xtm	Wed Aug 26 12:24:42 2009
@@ -7,6 +7,7 @@
     <tm:subjectIdentifier href="http://some.where/author/Goethe"/>
     <tm:instanceOf><tm:topicRef href="#author"/></tm:instanceOf>
     <tm:name>
+      <tm:itemIdentity href="http://some.where/name_ii_1"/>
       <tm:type><tm:topicRef href="#firstName"/></tm:type>
       <tm:value>Johann Wolfgang</tm:value>
     </tm:name>
@@ -17,7 +18,7 @@
   </tm:topic>
 
   <tm:topic id="UUID-born-event">
-    <tm:instanceOf href="#event"/>
+    <tm:instanceOf><tm:topicRef href="#event"/></tm:instanceOf>
     <tm:occurrence>
       <tm:type><tm:topicRef href="#date"/></tm:type>
       <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#date">28.08.1749</tm:resourceData>
@@ -55,6 +56,10 @@
     <tm:subjectIdentifier href="http://some.where/metropolis/Berlin"/>
     <tm:instanceOf><tm:topicRef href="#metropolis"/></tm:instanceOf>
     <tm:occurrence>
+      <tm:type><tm:topicRef href="#fullName"/></tm:type>
+      <tm:resourceData>Berlin</tm:resourceData>
+    </tm:occurrence>
+    <tm:occurrence>
       <tm:type><tm:topicRef href="#population"/></tm:type>
       <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#unsignedLong">3431473</tm:resourceData>
     </tm:occurrence>
@@ -72,6 +77,10 @@
     <tm:subjectIdentifier href="http://some.where/city/Weimar"/>
     <tm:instanceOf><tm:topicRef href="#city"/></tm:instanceOf>
     <tm:occurrence>
+      <tm:type><tm:topicRef href="#fullName"/></tm:type>
+      <tm:resourceData>Weimar</tm:resourceData>
+    </tm:occurrence>
+    <tm:occurrence>
       <tm:type><tm:topicRef href="#population"/></tm:type>
       <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#unsignedLong">64720</tm:resourceData>
     </tm:occurrence>
@@ -86,6 +95,8 @@
     <tm:subjectLocator href="http://some.where/resource_2"/>
     <tm:instanceOf><tm:topicRef href="#poem"/></tm:instanceOf>
     <tm:occurrence>
+      <tm:itemIdentity href="http://some.where/occurrence_ii_1"/>
+      <tm:itemIdentity href="http://some.where/occurrence_ii_2"/>
       <tm:type><tm:topicRef href="#title"/></tm:type>
       <tm:scope>
 	<tm:topicRef href="#de"/>
@@ -147,7 +158,7 @@
     <tm:occurrence>
       <tm:type><tm:topicRef href="#content"/></tm:type>
       <tm:scope><tm:topicRef href="#de"/></tm:scope>
-      <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string"> Bedecke deinen Himmel, Zeus, ... </tm:resourceData>
+      <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string">Bedecke deinen Himmel, Zeus, ...</tm:resourceData>
     </tm:occurrence>
   </tm:topic>
 
@@ -284,7 +295,7 @@
   </tm:topic>
 
   <tm:topic id="lastName">
-    <tm:subjectIdentifier href="http://some.where/relationsip/lastName"/>
+    <tm:subjectIdentifier href="http://some.where/relationship/lastName"/>
   </tm:topic>
 
   <tm:topic id="event">
@@ -589,6 +600,11 @@
     <tm:name>
       <tm:type><tm:topicRef href="#firstName"/></tm:type>
       <tm:value>Johann Christoph Friedrich</tm:value>
+      <tm:variant>
+	<tm:itemIdentity href="http://some.where/variant_ii_1"/>
+	<tm:scope><tm:topicRef href="#display"/></tm:scope>
+	<tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string">Friedrich</tm:resourceData>
+      </tm:variant>
     </tm:name>
     <tm:name>
       <tm:type><tm:topicRef href="#lastName"/></tm:type>
@@ -600,6 +616,10 @@
     </tm:occurrence>
   </tm:topic>
 
+  <tm:topic id="display">
+    <tm:subjectIdentifier href="http://www.topicmaps.org/xtm/1.0/core.xtm#display"/>
+  </tm:topic>
+
   <tm:topic id="associatedWithEachOther">
     <tm:subjectIdentifier href="http://some.where/relationship/associatedWithEachOther"/>
   </tm:topic>
@@ -628,6 +648,7 @@
       <tm:topicRef href="#poem"/>
     </tm:role>
     <tm:role>
+      <tm:itemIdentity href="http://some.where/test-role"/>
       <tm:type><tm:topicRef href="#literature"/></tm:type>
       <tm:topicRef href="#ballad"/>
     </tm:role>

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	Wed Aug 26 12:24:42 2009
@@ -32,8 +32,7 @@
 		*rdf-subject*
 		*rdf-object*
 		*rdf-predicate*
-		*rdf-statement*
-		*xml-string*)
+		*rdf-statement*)
   (:import-from :xml-tools
                 xpath-child-elems-by-qname
 		xpath-single-child-elem-by-qname

Modified: trunk/src/unit_tests/unittests-constants.lisp
==============================================================================
--- trunk/src/unit_tests/unittests-constants.lisp	(original)
+++ trunk/src/unit_tests/unittests-constants.lisp	Wed Aug 26 12:24:42 2009
@@ -29,7 +29,8 @@
 	   :*t100.xtm*
 	   :*atom_test.xtm*
 	   :*atom-conf.lisp*
-	   :*poems_light.rdf*))
+	   :*poems_light.rdf*
+	   :*poems_light.xtm*))
 
 (in-package :unittests-constants)
 
@@ -93,4 +94,8 @@
 
 (defparameter *poems_light.rdf*
   (asdf:component-pathname
-   (asdf:find-component *unit-tests-component* "poems_light.rdf")))
\ No newline at end of file
+   (asdf:find-component *unit-tests-component* "poems_light.rdf")))
+
+(defparameter *poems_light.xtm*
+  (asdf:component-pathname
+   (asdf:find-component *unit-tests-component* "poems_light.xtm")))

Modified: trunk/src/xml/rdf/exporter.lisp
==============================================================================
--- trunk/src/xml/rdf/exporter.lisp	(original)
+++ trunk/src/xml/rdf/exporter.lisp	Wed Aug 26 12:24:42 2009
@@ -35,6 +35,21 @@
 (defvar *ns-map* nil) ;; ((:prefix <string> :uri <string>))
 
 
+(defmacro with-property (construct &body body)
+  "Generates a property element with a corresponding namespace
+   and tag name before executing the body. This macro is for usin
+   in occurrences and association that are mapped to RDF properties."
+  `(let ((ns-list
+	  (separate-uri (uri (first (psis (instance-of ,construct)))))))
+     (declare ((or OccurrenceC AssociationC) ,construct))
+     (let ((ns (getf ns-list :prefix))
+	   (tag-name (getf ns-list :suffix)))
+       (cxml:with-namespace ((get-ns-prefix ns) ns)
+	 (cxml:with-element (concatenate 'string (get-ns-prefix ns)
+					 ":" tag-name)
+	   , at body)))))
+
+
 (defun export-rdf (rdf-path &key tm-id (revision (get-revision)))
   "Exports the topoic map bound to tm-id as RDF."
   (with-reader-lock
@@ -206,6 +221,7 @@
    properties itemIdentity, scope and value."
   (cxml:with-element "isi:variant"
     (cxml:attribute "rdf:parseType" "Resource")
+    (make-isi-type "Variant")
     (map 'list #'to-rdf-elem (item-identifiers construct))
     (scopes-to-rdf-elems construct)
     (resourceX-to-rdf-elem construct)))
@@ -216,7 +232,7 @@
    properties itemIdentity, nametype, value, variant and scope."
   (cxml:with-element "isi:name"
     (cxml:attribute "rdf:parseType" "Resource")
-    (make-isi-type "name")
+    (make-isi-type "Name")
     (map 'list #'to-rdf-elem (item-identifiers construct))
     (cxml:with-element "isi:nametype"
       (make-topic-reference (instance-of construct)))
@@ -240,24 +256,18 @@
 	    (/= (length (psis (instance-of construct))) 1))
 	(cxml:with-element "isi:occurrence"
 	  (cxml:attribute "rdf:parseType" "Resource")
-	  (make-isi-type "occurrence")
+	  (make-isi-type "Occurrence")
 	  (map 'list #'to-rdf-elem (item-identifiers construct))
 	  (cxml:with-element "isi:occurrencetype"
 	    (make-topic-reference (instance-of construct)))
 	  (scopes-to-rdf-elems construct)
 	  (resourceX-to-rdf-elem construct))
-	(let ((ns-list
-	       (separate-uri (uri (first (psis (instance-of construct)))))))
-	  (let ((ns (getf ns-list :prefix))
-		(tag-name (getf ns-list :suffix)))
-	    (cxml:with-namespace ((get-ns-prefix ns) ns)
-	      (cxml:with-element (concatenate 'string (get-ns-prefix ns)
-					      ":" tag-name)
-		(cxml:attribute "rdf:datatype" (datatype construct))
-		(when (themes construct)
-		  (cxml:attribute "xml:lang" (get-xml-lang
-					      (first (themes construct)))))
-		(cxml:text (charvalue construct)))))))))
+	(with-property construct
+	  (cxml:attribute "rdf:datatype" (datatype construct))
+	  (when (themes construct)
+	    (cxml:attribute "xml:lang" (get-xml-lang
+					(first (themes construct)))))
+	  (cxml:text (charvalue construct))))))
 
 
 (defmethod to-rdf-elem ((construct TopicC))
@@ -269,9 +279,9 @@
 		    (occurrences construct)))
 	   (or (used-as-type construct)
 	       (used-as-theme construct)
-	       (player-in-roles construct)))
+	       (xml-lang-p construct)))
       nil ;; do not export this topic explicitly, since it has been exported as
-          ;; rdf:resource, rdf:about or any other reference
+          ;; rdf:resource, property or any other reference
       (cxml:with-element "rdf:Description"
 	(let ((psi (when (psis construct)
 		     (first (psis construct))))
@@ -285,7 +295,7 @@
 	  (when (or (> (length (psis construct)) 1)
 		    ii sl t-names
 		    (isi-occurrence-p construct))
-	    (make-isi-type "topic"))
+	    (make-isi-type "Topic"))
 	  (map 'list #'to-rdf-elem (remove psi (psis construct)))
 	  (map 'list #'to-rdf-elem sl)
 	  (map 'list #'to-rdf-elem ii)
@@ -336,7 +346,7 @@
 	(association-roles (roles association)))
     (cxml:with-element "rdf:Description" 
       (cxml:attribute "rdf:nodeID" (make-object-id association))
-      (make-isi-type "association")
+      (make-isi-type "Association")
       (cxml:with-element "isi:associationtype"
 	(make-topic-reference association-type))
       (map 'list #'to-rdf-elem ii)
@@ -352,7 +362,7 @@
 	(player-top (player construct)))
     (cxml:with-element "isi:role"
       (cxml:attribute "rdf:parseType" "Resource")
-      (make-isi-type "role")
+      (make-isi-type "Role")
       (map 'list #'to-rdf-elem ii)
       (cxml:with-element "isi:roletype"
 	(make-topic-reference role-type))
@@ -384,12 +394,5 @@
 		(cxml:attribute "rdf:about" (uri psi))
 		(cxml:attribute "rdf:nodeID"
 				(make-object-id (player subject-role))))
-	    (let ((ns-list
-		   (separate-uri (uri
-				  (first (psis (instance-of association)))))))
-	      (let ((ns (getf ns-list :prefix))
-		    (tag-name (getf ns-list :suffix)))
-		(cxml:with-namespace ((get-ns-prefix ns) ns)
-		  (cxml:with-element (concatenate 'string (get-ns-prefix ns)
-						  ":" tag-name)
-		    (make-topic-reference (player object-role))))))))))))
\ No newline at end of file
+	    (with-property association
+	      (make-topic-reference (player object-role)))))))))
\ No newline at end of file



From lgiessmann at common-lisp.net  Thu Aug 27 09:10:56 2009
From: lgiessmann at common-lisp.net (Lukas Giessmann)
Date: Thu, 27 Aug 2009 05:10:56 -0400
Subject: [isidorus-cvs] r121 - trunk/src/xml/rdf
Message-ID: <E1Mgb0S-0005sw-6l@common-lisp.net>

Author: lgiessmann
Date: Thu Aug 27 05:10:55 2009
New Revision: 121

Log:
rdf-exporter: changed the handling of associations that were mapped from rdf->tm, thus currently the rdf-mapped associatons are exported directly as rdf-property within an rdf-resource-node. rdf:_n is transformed to rdf:li, therefor associations rdf-mapped-associations and occurrences that will be mapped as usual rdf-properties are sorted by there type-psi; note all unit tests has to be updated, since the exported dom has a different structure

Modified:
   trunk/src/xml/rdf/exporter.lisp

Modified: trunk/src/xml/rdf/exporter.lisp
==============================================================================
--- trunk/src/xml/rdf/exporter.lisp	(original)
+++ trunk/src/xml/rdf/exporter.lisp	Thu Aug 27 05:10:55 2009
@@ -24,23 +24,54 @@
   (:import-from :isidorus-threading
 		with-reader-lock
 		with-writer-lock)
-  (:import-from :exporter
-		*export-tm*
-		export-to-elem)
   (:export :export-rdf))
 
 (in-package :rdf-exporter)
 
 
+(defvar *export-tm* nil "TopicMap which is exported (nil if all is
+                         to be exported, the same mechanism as
+                         in xtm-exporter")
+
 (defvar *ns-map* nil) ;; ((:prefix <string> :uri <string>))
 
 
+(defun rdf-li-or-uri (uri)
+  "Returns a string which represents an URI. If the given URI is
+   of the type rdf:_n there will be returned rdf:li."
+  (let ((rdf-len (length *rdf-ns*)))
+    (let ((prep-uri (when (string-starts-with
+			   uri (concatenate 'string *rdf-ns* "_"))
+		      (subseq uri (+ rdf-len 1)))))
+      (if prep-uri
+	  (handler-case (progn
+			  (parse-integer prep-uri)
+			  (concatenate 'string *rdf-ns* "li"))
+	    (condition () uri))
+	  uri))))
+
+
+(defun init-*ns-map* ()
+  "Initializes the variable *ns-map* woith some prefixes and corresponding
+   namepsaces. So the predifend namespaces are not contain ed twice."
+  (setf *ns-map* (list
+		  (list :prefix "isi"
+			:uri *tm2rdf-ns*)
+		  (list :prefix "rdf"
+			:uri *rdf-ns*)
+		  (list :prefix "rdfs"
+			:uri *rdfs-ns*)
+		  (list :prefix "xml"
+			:uri *xml-ns*))))
+
+
 (defmacro with-property (construct &body body)
   "Generates a property element with a corresponding namespace
    and tag name before executing the body. This macro is for usin
    in occurrences and association that are mapped to RDF properties."
   `(let ((ns-list
-	  (separate-uri (uri (first (psis (instance-of ,construct)))))))
+	  (separate-uri (rdf-li-or-uri
+			 (uri (first (psis (instance-of ,construct))))))))
      (declare ((or OccurrenceC AssociationC) ,construct))
      (let ((ns (getf ns-list :prefix))
 	   (tag-name (getf ns-list :suffix)))
@@ -50,12 +81,34 @@
 	   , at body)))))
 
 
+(defmacro export-to-elem (tm to-elem)
+  "Exports all topics and associations depending to the given
+   tm. If tm is nil all topics and associations are exported.
+   Thic macro is equal to the one in xtm-exporter with a different
+   handler for associations."
+  `(setf *export-tm* ,tm)
+  `(format t "*export-tm*: ~a" *export-tm*)
+  `(map 'list 
+        ,to-elem
+        (remove-if 
+         #'null 
+         (map 'list 
+              #'(lambda(top)
+                  (d:find-item-by-revision top revision))
+              (if ,tm
+                  (union
+                    (d:topics ,tm) (d:associations ,tm))
+                  (union
+                   (elephant:get-instances-by-class 'd:TopicC)
+                   (list-tm-associations)))))))
+
+
 (defun export-rdf (rdf-path &key tm-id (revision (get-revision)))
   "Exports the topoic map bound to tm-id as RDF."
   (with-reader-lock
     (let ((tm (when tm-id
 		(get-item-by-item-identifier tm-id :revision revision))))
-      (setf *ns-map* nil)
+      (init-*ns-map*)
       (setf *export-tm* tm)
       (with-revision revision
 	(with-open-file (stream rdf-path :direction :output)
@@ -288,7 +341,8 @@
 	      (ii (item-identifiers construct))
 	      (sl (locators construct))
 	      (t-names (names construct))
-	      (t-occs (occurrences construct)))
+	      (t-occs (occurrences construct))
+	      (t-assocs (list-rdf-mapped-associations construct)))
 	  (if psi
 	      (cxml:attribute "rdf:about" (uri psi))
 	      (cxml:attribute "rdf:nodeID" (make-object-id construct)))
@@ -308,7 +362,20 @@
 			   (make-topic-reference x)))
 	       (list-super-types construct))
 	  (map 'list #'to-rdf-elem t-names)
-	  (map 'list #'to-rdf-elem t-occs)))))
+	  (map 'list #'to-rdf-elem (sort-constructs
+				    (union t-occs t-assocs)))))))
+
+
+(defun sort-constructs (constructs)
+  "Sorts names and associations by the instance-of name.
+   So rdf:_n can be exported in the correct order."
+  (sort constructs #'(lambda(x y)
+		       (declare ((or OccurrenceC AssociationC) x y))
+		       (let ((x-psi (when (psis (instance-of x))
+				      (uri (first (psis (instance-of x))))))
+			     (y-psi (when (psis (instance-of y))
+				      (uri (first (psis (instance-of y)))))))
+			 (string< x-psi y-psi)))))
   
 
 (defmethod to-rdf-elem ((construct AssociationC))
@@ -387,12 +454,52 @@
 				association-roles)))
       (when (and subject-role object-role
 		 (= (length association-roles) 2))
-	(cxml:with-element "rdf:Description"
-	  (let ((psi (when (psis (player subject-role))
-		       (first (psis (player subject-role))))))
-	    (if psi
-		(cxml:attribute "rdf:about" (uri psi))
-		(cxml:attribute "rdf:nodeID"
-				(make-object-id (player subject-role))))
-	    (with-property association
-	      (make-topic-reference (player object-role)))))))))
\ No newline at end of file
+	(with-property association
+	  (make-topic-reference (player object-role)))))))
+
+
+(defun list-rdf-mapped-associations(subject-topic)
+  "Returns all associations that were mapped from RDF to TM
+   and are still having two roles of the type isi:subject and
+   isi:object."
+  (declare (TopicC subject-topic))
+  (let ((isi-subject (get-item-by-psi *rdf2tm-subject*))
+	(isi-object (get-item-by-psi *rdf2tm-object*)))
+    (let ((topic-roles
+	   (remove-if
+	    #'null
+	    (map 'list 
+		 #'(lambda(x)
+		     (when (and (eql (instance-of x) isi-subject)
+				(= (length (roles (parent x))) 2)
+				(find-if #'(lambda(y)
+					     (eql (instance-of y) isi-object))
+					 (roles (parent x))))
+		       x))
+		 (player-in-roles subject-topic)))))
+      (map 'list #'parent topic-roles))))
+
+
+(defun list-tm-associations()
+  "Returns a list of associations that were not mapped from RDF
+   and are not of the type type-instance or supertype-subtype."
+  (let ((isi-subject (get-item-by-psi *rdf2tm-subject*))
+	(isi-object (get-item-by-psi *rdf2tm-object*))
+	(type-instance (get-item-by-psi *type-instance-psi*))
+	(supertype-subtype (get-item-by-psi *supertype-subtype-psi*)))
+    (remove-if 
+     #'null
+     (map 'list 
+	  #'(lambda(x)
+	      (when (and
+		     (not (or (eql (instance-of x) type-instance)
+			      (eql (instance-of x) supertype-subtype)))
+		     (or (/= (length (roles x)) 2)
+			 (not (find-if #'(lambda(y)
+					   (eql (instance-of y) isi-object))
+				       (roles x)))
+			 (not (find-if #'(lambda(y)
+					   (eql (instance-of y) isi-subject))
+				       (roles x)))))
+		x))
+	  (elephant:get-instances-by-class 'AssociationC)))))
\ No newline at end of file



From lgiessmann at common-lisp.net  Thu Aug 27 10:48:17 2009
From: lgiessmann at common-lisp.net (Lukas Giessmann)
Date: Thu, 27 Aug 2009 06:48:17 -0400
Subject: [isidorus-cvs] r122 - trunk/src/unit_tests
Message-ID: <E1MgcWf-0005eR-DK@common-lisp.net>

Author: lgiessmann
Date: Thu Aug 27 06:48:16 2009
New Revision: 122

Log:
rdf-exporter: updated all unit tests to the last changes

Modified:
   trunk/src/unit_tests/poems_light.xtm

Modified: trunk/src/unit_tests/poems_light.xtm
==============================================================================
--- trunk/src/unit_tests/poems_light.xtm	(original)
+++ trunk/src/unit_tests/poems_light.xtm	Thu Aug 27 06:48:16 2009
@@ -148,7 +148,7 @@
   </tm:topic>
 
   <tm:topic id="prometheus">
-    <tm:subjectIdentifier href="http://some.where/ballad/Prometheus"/>
+    <tm:subjectIdentifier href="http://some.where/poem/Prometheus"/>
     <tm:instanceOf><tm:topicRef href="#poem"/></tm:instanceOf>
     <tm:occurrence>
       <tm:type><tm:topicRef href="#title"/></tm:type>



From lgiessmann at common-lisp.net  Thu Aug 27 10:49:28 2009
From: lgiessmann at common-lisp.net (Lukas Giessmann)
Date: Thu, 27 Aug 2009 06:49:28 -0400
Subject: [isidorus-cvs] r123 - trunk/src/unit_tests
Message-ID: <E1MgcXo-0005fy-Bn@common-lisp.net>

Author: lgiessmann
Date: Thu Aug 27 06:49:28 2009
New Revision: 123

Log:


Added:
   trunk/src/unit_tests/rdf_exporter_test.lisp

Added: trunk/src/unit_tests/rdf_exporter_test.lisp
==============================================================================
--- (empty file)
+++ trunk/src/unit_tests/rdf_exporter_test.lisp	Thu Aug 27 06:49:28 2009
@@ -0,0 +1,883 @@
+;;+-----------------------------------------------------------------------------
+;;+  Isidorus
+;;+  (c) 2008-2009 Marc Kuester, Christoph Ludwig, Lukas Giessmann
+;;+
+;;+  Isidorus is freely distributable under the LGPL license.
+;;+  You can find a detailed description in trunk/docs/LGPL-LICENSE.txt.
+;;+-----------------------------------------------------------------------------
+
+
+(defpackage :rdf-exporter-test
+  (:use 
+   :common-lisp
+   :xml-importer
+   :datamodel
+   :it.bese.FiveAM
+   :fixtures)
+  (:import-from :constants
+                *rdf-ns*
+		*rdfs-ns*
+		*rdf2tm-ns*
+		*tm2rdf-ns*
+		*xml-ns*
+		*xml-string*
+		*xml-uri*)
+  (:import-from :xml-tools
+                xpath-child-elems-by-qname
+		xpath-single-child-elem-by-qname
+                xpath-select-location-path
+		get-ns-attribute)
+  (:export :run-rdf-exporter-tests
+	   :test-resources
+	   :test-goethe
+	   :test-erlkoenig
+	   :test-prometheus
+	   :test-zauberlehrling
+	   :test-frankfurt
+	   :test-weimar
+	   :test-berlin
+	   :test-region
+	   :test-city-and-metropolis
+	   :test-germany
+	   :test-german
+	   :test-born-event
+	   :test-died-event
+	   :test-dateRange-zauberlehrling
+	   :test-dateRange-erlkoenig
+	   :test-dateRange-prometheus
+	   :test-schiller
+	   :test-single-nodes
+	   :test-collection
+	   :test-association))
+
+(declaim (optimize (debug 3) (speed 0) (safety 3) (space 0) (compilation-speed 0)))
+
+(in-package :rdf-exporter-test)
+
+
+(def-suite rdf-exporter-test
+     :description "tests  various key functions of the exporter")
+
+(in-suite rdf-exporter-test)
+
+
+(defvar *sw-arc* "http://some.where/relationship/")
+(defvar *xml-ulong* "http://www.w3.org/2001/XMLSchema#unsignedLong")
+(defvar *xml-date* "http://www.w3.org/2001/XMLSchema#date")
+
+
+(defun get-dom-root ()
+  "Returns the document's root node."
+  (let ((dom (cxml:parse-file "./__out__.rdf" (cxml-dom:make-dom-builder))))
+    (when dom
+      (let ((child-nodes (dom:child-nodes dom)))
+	(when (> (length child-nodes) 0)
+	  (elt child-nodes 0))))))
+
+
+(defun identifier-p (owner-elem value &key (what "itemIdentity"))
+  "Returns t if the owner element owns a property correponding to the
+   attribute what and the value."
+  (literal-p owner-elem *tm2rdf-ns* what value :datatype *xml-uri*))
+
+
+(defun role-p (owner-elem roletype-uri item-identifiers 
+	       &key (player-uri nil) (player-id nil))
+  "Returns t if the owner-element has a node that corresponds to a
+   role with the given parameters."
+  (loop for item across (dom:child-nodes owner-elem)
+     when (let ((node-ns (dom:namespace-uri item))
+		(node-name (rdf-importer::get-node-name item)))
+	    (and (= (length (dom:child-nodes item)) 
+		    (+ 3 (length item-identifiers)))
+		 (string= node-ns *tm2rdf-ns*)
+		 (string= node-name "role")
+		 (type-p item (concatenate 'string *tm2rdf-ns* "Role"))
+		 (if player-uri
+		     (property-p item *tm2rdf-ns* "player"
+				 :resource player-uri)
+		     (property-p item *tm2rdf-ns* "player"
+				 :nodeID player-id))
+		 (property-p item *tm2rdf-ns* "roletype"
+			     :resource roletype-uri)
+		 (= (length item-identifiers)
+		    (length (loop for ii in item-identifiers
+			       when (identifier-p item ii)
+			       collect ii)))))
+     return t))
+
+
+(defun get-resources-by-uri (uri)
+  "Returns a list of resource elements that owns the attribute
+   about with the value of uri."
+  (let ((root (get-dom-root)))
+    (let ((resources (xpath-child-elems-by-qname root *rdf-ns* "Description")))
+      (loop for item across resources
+	 when (string= (get-ns-attribute item "about") uri)
+	 collect item))))
+
+
+(defun get-resources-by-id (id)
+  "Returns a list of resource elements that owns the attribute
+   nodeID with the value of id."
+  (let ((root (get-dom-root)))
+    (let ((resources (xpath-child-elems-by-qname root *rdf-ns* "Description")))
+      (loop for item across resources
+	 when (string= (get-ns-attribute item "nodeID") id)
+	 collect item))))
+
+
+(defun type-p (owner-elem type-uri)
+  "Returns t if the given uri is contained in a property
+   within the owner-elem."
+  (loop for item across (dom:child-nodes owner-elem)
+     when (let ((node-ns (dom:namespace-uri item))
+		(node-name (rdf-importer::get-node-name item))
+		(resource (rdf-importer::get-ns-attribute
+			   item "resource")))
+	    (and (string= node-ns *rdf-ns*)
+		 (string= node-name "type")
+		 (string= resource type-uri)))
+     return t))
+
+
+(defun literal-p (owner-elem arc-uri arc-name literal-value
+		  &key (datatype *xml-string*)
+		  (xml-lang nil))
+  "Returns t if the owner-elem contains an arc with the uri
+   arc-uri, the arc-name and the literal content literal-value."
+  (loop for item across (dom:child-nodes owner-elem)
+     when (let ((node-ns (dom:namespace-uri item))
+		(node-name (rdf-importer::get-node-name item))
+		(value (rdf-importer::child-nodes-or-text item :trim nil))
+		(fn-datatype (rdf-importer::get-ns-attribute item "datatype"))
+		(fn-xml-lang (rdf-importer::get-ns-attribute
+			      item "lang" :ns-uri *xml-ns*)))
+	    (and (string= node-ns arc-uri)
+		 (string= node-name arc-name)
+		 (and (stringp literal-value)
+		      (string= value literal-value))
+		 (string= datatype (if fn-datatype
+				       fn-datatype
+				       ""))
+		 (or (not (or xml-lang fn-xml-lang))
+		     (and (and xml-lang fn-xml-lang)
+			  (string= xml-lang fn-xml-lang)))))
+     return t))
+
+
+(defun property-p (owner-elem arc-uri arc-name
+		   &key (resource "") (nodeID ""))
+  "Returns t if the owner element owns a property with the
+   given characteristics."
+  (if (and (string= resource "") (string= nodeID ""))
+      nil
+      (loop for item across (dom:child-nodes owner-elem)
+	 when (let ((node-ns (dom:namespace-uri item))
+		    (node-name (rdf-importer::get-node-name item))
+		    (fn-resource (unless (dom:text-node-p  item)
+				   (rdf-importer::get-ns-attribute item
+								   "resource")))
+		    (fn-nodeID (rdf-importer::get-ns-attribute item "nodeID")))
+		(and (string= node-ns arc-uri)
+		     (string= node-name arc-name)
+		     (or (and fn-resource
+			      (string= fn-resource resource))
+			 (and fn-nodeID
+			      (string= fn-nodeID nodeID)))))
+	 return t)))
+
+
+(defun variant-p (owner-elem variant-scopes item-identifiers variant-value
+		  &key (datatype *xml-string*))
+  "Returns t if the owner contains a variant element with the passed
+   characteristics."
+    (loop for item across (dom:child-nodes owner-elem)
+       when (let ((node-ns (dom:namespace-uri item))
+		  (node-name (rdf-importer::get-node-name item)))
+	      (and (= (+ (length variant-scopes)
+			 (length item-identifiers)
+			 2)
+		      (length (dom:child-nodes owner-elem)))
+		   (string= node-ns *tm2rdf-ns*)
+		   (string= node-name "variant")
+		   (literal-p item *tm2rdf-ns* "value" variant-value
+			      :datatype datatype)
+		   (= (length variant-scopes)
+		      (length (loop for scope in variant-scopes
+				 when (property-p item *tm2rdf-ns* "scope"
+						  :resource scope)
+				 collect scope)))
+		   (= (length item-identifiers)
+		      (length (loop for ii in item-identifiers
+				 when (identifier-p item ii)
+				 collect ii)))
+		   (type-p item (concatenate 'string *tm2rdf-ns* "Variant"))))
+       return t))
+
+
+(defun name-p (owner-elem name-type name-scopes item-identifiers name-value
+	       &key (variants nil))
+  "Returns t if the parent node owns a name with the given characterics."
+  (loop for item across (dom:child-nodes owner-elem)
+     when (let ((node-ns (dom:namespace-uri item))
+		(node-name (rdf-importer::get-node-name item)))
+	    (and (= (length (dom:child-nodes item))
+		    (+ 3 (length name-scopes)
+		       (length item-identifiers)
+		       (length variants)))
+		 (string= node-ns *tm2rdf-ns*)
+		 (string= node-name "name")
+		 (type-p item (concatenate 'string *tm2rdf-ns*
+					   "Name"))
+		 (property-p item *tm2rdf-ns* "nametype" :resource name-type)
+		 (= (length name-scopes)
+		    (length (loop for scope in name-scopes
+			       when (property-p item *tm2rdf-ns* "scope"
+						:resource scope)
+			       collect scope)))
+		 (= (length item-identifiers)
+		    (length (loop for ii in item-identifiers
+			       when (identifier-p item ii)
+			       collect ii)))
+		 (= (length variants)
+		    (length (loop for variant in variants
+			       when (variant-p
+				     item (getf variant :scopes)
+				     (getf variant :item-identifiers)
+				     (getf variant :value)
+				     :datatype (getf variant :datatype))
+			       collect variant)))
+		 (literal-p item *tm2rdf-ns* "value" name-value)))
+     return t))
+
+
+(defun occurrence-p (owner-elem occurrence-type occurrence-scopes
+		     item-identifiers occurrence-value 
+		     &key (datatype *xml-string*))
+  "Returns t if the parent node owns an occurrence with the given characterics."
+  (loop for item across (dom:child-nodes owner-elem)
+     when (let ((node-ns (dom:namespace-uri item))
+		(node-name (rdf-importer::get-node-name item)))
+	    (and (= (length (dom:child-nodes item))
+		    (+ 3 (length occurrence-scopes)
+		       (length item-identifiers)))
+		 (string= node-ns *tm2rdf-ns*)
+		 (string= node-name "occurrence")
+		 (type-p item (concatenate 'string *tm2rdf-ns*
+					   "Occurrence"))
+		 (property-p item *tm2rdf-ns* "occurrencetype"
+			     :resource occurrence-type)
+		 (= (length occurrence-scopes)
+		    (length (loop for scope in occurrence-scopes
+			       when (property-p item *tm2rdf-ns* "scope"
+						:resource scope)
+			       collect scope)))
+		 (= (length item-identifiers)
+		    (length (loop for ii in item-identifiers
+			       when (identifier-p item ii)
+			       collect ii)))
+		 (literal-p item *tm2rdf-ns* "value" occurrence-value
+			    :datatype datatype)))
+     return t))
+
+	    
+(test test-resources
+  "Tests the general amount of resources."
+  (with-fixture rdf-exporter-test-db ()
+    (let ((root (get-dom-root)))
+      (is-true root)
+      (let ((resources (xpath-child-elems-by-qname root *rdf-ns* "Description")))
+	(is (= (length resources) 29))
+	(is (= (length (loop for item across resources
+			  when (get-ns-attribute item "about")
+			  collect item))
+	       19))
+	(is (= (length (loop for item across resources
+			  when (get-ns-attribute item "nodeID")
+			  collect item))
+	       10))))))
+
+
+(test test-goethe
+  "Tests the resource goethe."
+  (with-fixture rdf-exporter-test-db ()
+    (let ((goethes (get-resources-by-uri "http://some.where/author/Goethe")))
+      (is (= (length goethes) 1))
+      (let ((me (find-if #'(lambda(x)
+			     (= (length (dom:child-nodes x)) 7))
+			 goethes)))
+	(is-true me)
+	(is (type-p me "http://isidorus/tm2rdf_mapping/Topic"))
+	(is (type-p me "http://some.where/types/Author"))
+	(is (literal-p me *sw-arc* "lastName"
+		       "von Goethe"))
+	(is (name-p me "http://some.where/relationship/firstName" nil
+		    (list "http://some.where/name_ii_1") "Johann Wolfgang"))
+	(let ((born-id (concatenate
+			'string "id_"
+			(write-to-string
+			 (elephant::oid
+			  (d:topic
+			   (elephant:get-instance-by-value
+			    'd:OccurrenceC 'd:charvalue "28.08.1749"))))))
+	      (died-id (concatenate
+			'string "id_"
+			(write-to-string
+			 (elephant::oid
+			  (d:topic
+			   (elephant:get-instance-by-value
+			    'd:OccurrenceC 'd:charvalue "22.03.1832")))))))
+	  (is-true (property-p me *sw-arc* "born" :nodeID born-id))
+	  (is-true (property-p me *sw-arc* "died" :nodeID died-id)))
+	(is-true (loop for item across (dom:child-nodes me)
+		    when (let ((node-ns (dom:namespace-uri item))
+			       (node-name (rdf-importer::get-node-name item))
+			       (nodeID (rdf-importer::get-ns-attribute
+					item "nodeID")))
+			   (and (string= node-ns *sw-arc*)
+				(string= node-name "wrote")
+				nodeID))
+		    return t))))))
+
+
+(test test-erlkoenig
+  "Tests the resource erlkoenig."
+  (with-fixture rdf-exporter-test-db ()
+    (let ((erlkoenigs (get-resources-by-uri
+		       "http://some.where/ballad/Der_Erlkoenig")))
+      (is (= (length erlkoenigs) 1))
+      (let ((me (find-if #'(lambda(x)
+			     (= (length (dom:child-nodes x)) 5))
+			 erlkoenigs)))
+	(is-true me)
+	(is-true (type-p me "http://some.where/types/Ballad"))
+	(is-true (type-p me (concatenate 'string *tm2rdf-ns* "Topic")))
+	(is-true (literal-p me *sw-arc* "content"
+			    "Wer reitet so sp?t durch Nacht und Wind? ..."
+			    :xml-lang "de"))
+	(is-true (occurrence-p me "http://some.where/relationship/title"
+			       (list "http://some.where/scope/en") nil
+			       "Der Erlk?nig"))
+	(let ((dateRange-id
+	       (concatenate
+		'string "id_"
+		(write-to-string
+		 (elephant::oid
+		  (d:topic
+		   (elephant:get-instance-by-value
+		    'd:OccurrenceC 'd:charvalue "31.12.1782")))))))
+	  (is-true (property-p me *sw-arc* "dateRange"
+			       :nodeID dateRange-id)))))))
+
+
+(test test-prometheus
+  "Tests the resoruce prometheus."
+  (with-fixture rdf-exporter-test-db ()
+    (let ((prometheus (get-resources-by-uri
+		       "http://some.where/poem/Prometheus")))
+      (is (= (length prometheus) 1))
+      (let ((me (find-if #'(lambda(x)
+			     (= (length (dom:child-nodes x)) 4))
+			 prometheus)))
+	(is-true me)
+	(is-true (type-p me "http://some.where/types/Poem"))
+	(is-true (literal-p me *sw-arc* "title"
+			    "Prometheus" :xml-lang "de"))
+	(is-true (literal-p me *sw-arc* "content"
+			    "Bedecke deinen Himmel, Zeus, ..."
+			    :xml-lang "de"))
+	(let ((dateRange-id
+	       (concatenate
+		'string "id_"
+		(write-to-string
+		 (elephant::oid
+		  (d:topic
+		   (elephant:get-instance-by-value
+		    'd:OccurrenceC 'd:charvalue "01.01.1772")))))))
+	  (is-true (property-p me *sw-arc* "dateRange"
+			       :nodeID dateRange-id)))))))
+
+
+(test test-zauberlehrling
+  "Tests the resoruce zauberlehrling."
+  (with-fixture rdf-exporter-test-db ()
+    (let ((zauberlehrlings (get-resources-by-uri
+			   "http://some.where/poem/Der_Zauberlehrling")))
+      (is (= (length zauberlehrlings) ))
+      (let ((me (find-if #'(lambda(x)
+			     (= (length (dom:child-nodes x)) 10))
+			 zauberlehrlings)))
+	(is-true me)
+	(is-true (type-p me "http://some.where/types/Poem"))
+	(is-true (type-p me (concatenate 'string *tm2rdf-ns* "Topic")))
+	(is-true (identifier-p me "http://some.where/poem/Zauberlehrling"
+			       :what "subjectIdentifier"))
+	(is-true (identifier-p
+		  me "http://some.where/poem/Zauberlehrling_itemIdentity_1"))
+	(is-true (identifier-p
+		  me  "http://some.where/poem/Zauberlehrling_itemIdentity_2"))
+	(is-true (identifier-p me "http://some.where/resource_1"
+			       :what "subjectLocator"))
+	(is-true (identifier-p me "http://some.where/resource_2"
+			       :what "subjectLocator"))
+	(is-true (literal-p me "http://some.where/relationship/" "content"
+			    "Hat der alte Hexenmeister ..."))
+	(is-true (occurrence-p me "http://some.where/relationship/title"
+			       (list "http://some.where/scope/en"
+				     "http://isidorus/rdf2tm_mapping/scope/de")
+			       (list "http://some.where/occurrence_ii_1"
+				     "http://some.where/occurrence_ii_2")
+			       "Der Zauberlehrling"))
+	(let ((dateRange-id
+	       (concatenate
+		'string "id_"
+		(write-to-string
+		 (elephant::oid
+		  (d:topic
+		   (elephant:get-instance-by-value
+		    'd:OccurrenceC 'd:charvalue "01.01.1797")))))))
+	  (is-true (property-p me *sw-arc* "dateRange"
+			       :nodeID dateRange-id)))))))
+
+
+(test test-frankfurt
+  "Tests the resoruce frankfurt."
+  (with-fixture rdf-exporter-test-db ()
+    (let ((frankfurts (get-resources-by-uri
+			   "http://some.where/metropolis/FrankfurtMain")))
+      (is (= (length frankfurts) 1))
+      (let ((me (find-if #'(lambda(x)
+			     (= (length (dom:child-nodes x)) 4))
+			 frankfurts)))
+	(is-true me)
+	(is-true (type-p me "http://some.where/types/Metropolis"))
+	(is-true (literal-p me *sw-arc* "fullName" "Frankfurt am Main"))
+	(is-true (literal-p me *sw-arc* "population" "659000" 
+			    :datatype *xml-ulong*))
+	(is-true (property-p me *sw-arc* "locatedIn"
+			     :resource "http://some.where/country/Germany"))))))
+
+(test test-weimar
+  "Tests the resoruce weimar."
+  (with-fixture rdf-exporter-test-db ()
+    (let ((weimars (get-resources-by-uri
+			   "http://some.where/city/Weimar")))
+      (is (= (length weimars) 1))
+      (let ((me (find-if #'(lambda(x)
+			     (= (length (dom:child-nodes x)) 4))
+			 weimars)))
+	(is-true me)
+	(is-true (type-p me "http://some.where/types/City"))
+	(is-true (literal-p me *sw-arc* "fullName" "Weimar"))
+	(is-true (literal-p me *sw-arc* "population" "64720" 
+			    :datatype *xml-ulong*))
+	(is-true (property-p me *sw-arc* "locatedIn"
+			     :resource "http://some.where/country/Germany"))))))
+
+
+(test test-berlin
+  "Tests the resource berlin."
+  (with-fixture rdf-exporter-test-db ()
+    (let ((berlins (get-resources-by-uri
+		    "http://some.where/metropolis/Berlin")))
+      (is (= (length berlins) 1))
+      (let ((me (find-if #'(lambda(x)
+			     (= (length (dom:child-nodes x)) 4))
+			 berlins)))
+	(is-true me)
+	(is-true (type-p me "http://some.where/types/Metropolis"))
+	(is-true (literal-p me *sw-arc* "fullName" "Berlin"))
+	(is-true (literal-p me *sw-arc* "population" "3431473" 
+			    :datatype *xml-ulong*))
+	(is-true (property-p me *sw-arc* "locatedIn"
+			     :resource "http://some.where/country/Germany"))))))
+
+
+(test test-region 
+  "Tests the resource region."
+  (with-fixture rdf-exporter-test-db ()
+    (let ((regions (get-resources-by-uri
+		    "http://some.where/types/Region"))
+	  (citys (get-resources-by-uri
+		  "http://some.where/types/City"))
+	  (metropolis (get-resources-by-uri
+		       "http://some.where/types/Metropolis")))
+      (is (= (length regions) 1))
+      (is (= (length (dom:child-nodes (elt regions 0))) 0))
+      (is (= (length citys) 1))
+      (is (= (length (dom:child-nodes (elt citys 0))) 1))
+      (is-true (property-p (elt citys 0) *rdfs-ns* "subClassOf"
+			   :resource "http://some.where/types/Region"))
+      (is (= (length metropolis) 1))
+      (is (= (length (dom:child-nodes (elt metropolis 0))) 1))
+      (is-true (property-p (elt metropolis 0) *rdfs-ns* "subClassOf"
+			   :resource "http://some.where/types/Region")))))
+
+
+(test test-city-and-metropolis
+  "Tests the resource city and metropolis."
+  (with-fixture rdf-exporter-test-db ()
+      (let ((citys (get-resources-by-uri
+		  "http://some.where/types/City")))
+      (is (= (length citys) 1))
+      (is (= (length (dom:child-nodes (elt citys 0))) 1))
+      (is-true (property-p (elt citys 0) *rdfs-ns* "subClassOf"
+			   :resource "http://some.where/types/Region")))
+    (let ((metropolis (get-resources-by-uri
+		       "http://some.where/types/Metropolis")))
+      (is (= (length metropolis) 1))
+      (is (= (length (dom:child-nodes (elt metropolis 0))) 1))
+      (is-true (property-p (elt metropolis 0) *rdfs-ns* "subClassOf"
+			   :resource "http://some.where/types/Region")))))
+
+
+(test test-germany
+  "Tests the resource germany."
+    (with-fixture rdf-exporter-test-db ()
+      (let ((germanys (get-resources-by-uri
+		       "http://some.where/country/Germany")))
+      (is (= (length germanys) 1))
+      (let ((me (find-if #'(lambda(x)
+			     (= (length (dom:child-nodes x)) 5))
+			 germanys)))
+	(is-true me)
+	(is-true (type-p me "http://some.where/types/Country"))
+	(is-true (literal-p me *sw-arc* "nativeName" "Deutschland"
+			    :xml-lang "de"))
+	(is-true (literal-p me *sw-arc* "population" "82099232"
+			    :datatype *xml-ulong*))
+	(is-true (property-p me *sw-arc* "capital"
+			     :resource "http://some.where/metropolis/Berlin"))
+	(is-true (property-p me *sw-arc* "officialese"
+			     :resource "http://some.where/language/German"))))))
+
+
+(test test-german
+  "Tests the resource german."
+    (with-fixture rdf-exporter-test-db ()
+      (let ((germans (get-resources-by-uri
+		       "http://some.where/language/German")))
+      (is (= (length germans) 1))
+      (is-true (type-p (elt germans 0) "http://some.where/types/Language")))))
+
+
+(test test-born-event
+  "Tests the blank node of the born-event."
+  (with-fixture rdf-exporter-test-db ()
+    (let ((born-id (concatenate
+		    'string "id_"
+		    (write-to-string
+		     (elephant::oid
+		      (d:topic
+		       (elephant:get-instance-by-value 'd:OccurrenceC
+						       'd:charvalue
+						       "28.08.1749")))))))
+      (is-true born-id)
+      (let ((born-events (get-resources-by-id born-id)))
+	(is (= (length born-events) 1))
+	(let ((me (find-if #'(lambda(x)
+			       (= (length (dom:child-nodes x)) 3))
+			   born-events)))
+	  (is-true me)
+	  (is-true (literal-p me *sw-arc* "date" "28.08.1749"
+			      :datatype *xml-date*))
+	  (is-true (type-p me "http://some.where/types/Event"))
+	  (is-true 
+	   (property-p me *sw-arc* "place"
+		       :resource
+		       "http://some.where/metropolis/FrankfurtMain")))))))
+
+
+(test test-died-event
+  "Tests the blank node of the born-event."
+  (with-fixture rdf-exporter-test-db ()
+    (let ((born-id (concatenate
+		    'string "id_"
+		    (write-to-string
+		     (elephant::oid
+		      (d:topic
+		       (elephant:get-instance-by-value 'd:OccurrenceC
+						       'd:charvalue
+						       "22.03.1832")))))))
+      (is-true born-id)
+      (let ((born-events (get-resources-by-id born-id)))
+	(is (= (length born-events) 1))
+	(let ((me (find-if #'(lambda(x)
+			       (= (length (dom:child-nodes x)) 3))
+			   born-events)))
+	  (is-true me)
+	  (is-true (literal-p me *sw-arc* "date" "22.03.1832"
+			      :datatype *xml-date*))
+	  (is-true (type-p me "http://some.where/types/Event"))
+	  (is-true 
+	   (property-p me *sw-arc* "place"
+		       :resource
+		       "http://some.where/city/Weimar")))))))
+
+
+(test test-dateRange-zauberlehrling
+  "Tests the node of zauberlehrling's dateRange."
+  (with-fixture rdf-exporter-test-db ()
+    (let ((dr-id (concatenate
+		  'string "id_"
+		  (write-to-string
+		   (elephant::oid
+		    (d:topic
+		     (elephant:get-instance-by-value 'd:OccurrenceC
+						     'd:charvalue
+						     "01.01.1797")))))))
+      (is-true dr-id)
+      (let ((drs (get-resources-by-id dr-id)))
+	(is (= (length drs) 1))
+	(let ((me (elt drs 0)))
+	  (is-true (literal-p me *sw-arc* "start" "01.01.1797"
+			      :datatype *xml-date*))
+	  (is-true (literal-p me *sw-arc* "end" "31.12.1797"
+			      :datatype *xml-date*)))))))
+
+
+(test test-dateRange-erlkoenig
+  "Tests the node of erlkoenig's dateRange."
+  (with-fixture rdf-exporter-test-db ()
+    (let ((dr-id (concatenate
+		  'string "id_"
+		  (write-to-string
+		   (elephant::oid
+		    (d:topic
+		     (elephant:get-instance-by-value 'd:OccurrenceC
+						     'd:charvalue
+						     "01.01.1782")))))))
+      (is-true dr-id)
+      (let ((drs (get-resources-by-id dr-id)))
+	(is (= (length drs) 1))
+	(let ((me (elt drs 0)))
+	  (is-true (literal-p me *sw-arc* "start" "01.01.1782"
+			      :datatype *xml-date*))
+	  (is-true (literal-p me *sw-arc* "end" "31.12.1782"
+			      :datatype *xml-date*)))))))
+
+
+(test test-dateRange-prometheus
+  "Tests the node of prometheus' dateRange."
+  (with-fixture rdf-exporter-test-db ()
+    (let ((dr-id (concatenate
+		  'string "id_"
+		  (write-to-string
+		   (elephant::oid
+		    (d:topic
+		     (elephant:get-instance-by-value 'd:OccurrenceC
+						     'd:charvalue
+						     "01.01.1772")))))))
+      (is-true dr-id)
+      (let ((drs (get-resources-by-id dr-id)))
+	(is (= (length drs) 1))
+	(let ((me (elt drs 0)))
+	  (is-true (literal-p me *sw-arc* "start" "01.01.1772"
+			      :datatype *xml-date*))
+	  (is-true (literal-p me *sw-arc* "end" "31.12.1774"
+			      :datatype *xml-date*)))))))
+
+
+(test test-schiller
+  "Tests the node of schiller."
+  (with-fixture rdf-exporter-test-db ()
+    (let ((schiller-id (concatenate
+			'string "id_"
+			(write-to-string
+			 (elephant::oid
+			  (d:topic
+			   (elephant:get-instance-by-value
+			    'd:OccurrenceC 'd:charvalue
+			    "http://de.wikipedia.org/wiki/Schiller")))))))
+      (is-true schiller-id)
+      (is (= (length (get-resources-by-id schiller-id)) 1))
+      (let ((me (elt (get-resources-by-id schiller-id) 0)))
+	(is-true (type-p me "http://some.where/types/Author"))
+	(is-true (type-p me (concatenate 'string *tm2rdf-ns* "Topic")))
+	(is-true (literal-p me *sw-arc* "authorInfo"
+			    "http://de.wikipedia.org/wiki/Schiller"
+			    :datatype *xml-uri*))
+	(is-true 
+	 (name-p me "http://some.where/relationship/firstName"
+		 nil nil "Johann Christoph Friedrich"
+		 :variants
+		 (list
+		  (list 
+		   :item-identifiers
+		   (list "http://some.where/variant_ii_1")
+		   :scopes 
+		   (list "http://www.topicmaps.org/xtm/1.0/core.xtm#display")
+		   :value "Friedrich"
+		   :datatype *xml-string*))))
+	(is-true 
+	 (name-p me "http://some.where/relationship/lastName"
+		 nil nil "von Schiller"))))))
+
+
+(test test-single-nodes
+  "Tests all nodes that are not part of a statement."
+  (with-fixture rdf-exporter-test-db ()
+    (let ((authors (get-resources-by-uri "http://some.where/types/Author"))
+	  (events (get-resources-by-uri "http://some.where/types/Event"))
+	  (country (get-resources-by-uri "http://some.where/types/Country"))
+	  (poem (get-resources-by-uri "http://some.where/types/Poem"))
+	  (ballad (get-resources-by-uri "http://some.where/types/Ballad"))
+	  (language (get-resources-by-uri "http://some.where/types/Language"))
+	  (rdf-nil (get-resources-by-uri (concatenate 'string *rdf-ns* "nil"))))
+      (is-true authors)
+      (is (= (length authors) 1))
+      (is (= (length (dom:child-nodes (elt authors 0))) 0))
+      (is-true events)
+      (is (= (length events) 1))
+      (is (= (length (dom:child-nodes (elt events 0))) 0))
+      (is-true country)
+      (is (= (length country) 1))
+      (is (= (length (dom:child-nodes (elt country 0))) 0))
+      (is-true poem)
+      (is (= (length poem) 1))
+      (is (= (length (dom:child-nodes (elt poem 0))) 0))
+      (is-true ballad)
+      (is (= (length ballad) 1))
+      (is (= (length (dom:child-nodes (elt ballad 0))) 0))
+      (is-true language)
+      (is (= (length language) 1))
+      (is (= (length (dom:child-nodes (elt language 0))) 0))
+      (is-true rdf-nil)
+      (is (= (length rdf-nil) 1))
+      (is (= (length (dom:child-nodes (elt rdf-nil 0))) 0)))))
+
+
+(test test-collection
+  "Tests a collection that has be exported as a construct of rdf:first,
+   rdf:rest and rdf:nil."
+  (with-fixture rdf-exporter-test-db ()
+    (let ((goethes (get-resources-by-uri "http://some.where/author/Goethe")))
+      (let ((wrote-goethe
+	     (loop for item across (dom:child-nodes (elt goethes 0))
+		when (let ((node-ns (dom:namespace-uri item))
+			   (node-name (rdf-importer::get-node-name item)))
+		       (and (string= node-ns *sw-arc*)
+			    (string= node-name "wrote")))
+		return item)))
+	(let ((id-1 (rdf-importer::get-ns-attribute wrote-goethe"nodeID")))
+	  (is-true id-1)
+	  (let ((node-1s (get-resources-by-id id-1)))
+	    (is (= (length node-1s) 1))
+	    (is (= (length (dom:child-nodes (elt node-1s 0))) 2))
+	    (is-true (property-p (elt node-1s 0) *rdf-ns* "first"
+				 :resource
+				 "http://some.where/poem/Der_Zauberlehrling"))
+	    (let ((rest-arc-1
+		   (loop for item across (dom:child-nodes (elt node-1s 0))
+		      when (let ((node-ns (dom:namespace-uri item))
+				 (node-name (rdf-importer::get-node-name item))
+				 (nodeID (rdf-importer::get-ns-attribute
+					  item "nodeID")))
+			     (and (string= node-ns *rdf-ns*)
+				  (string= node-name "rest")
+				  nodeID))
+		      return item)))
+	      (is-true rest-arc-1)
+	      (let ((id-2 (rdf-importer::get-ns-attribute rest-arc-1 "nodeID")))
+		(let ((node-2s (get-resources-by-id id-2)))
+		  (is (= (length node-2s) 1))
+		  (is (= (length (dom:child-nodes (elt node-2s 0))) 2))
+		  (is-true (property-p
+			    (elt node-2s 0) *rdf-ns* "first"
+			    :resource
+			    "http://some.where/ballad/Der_Erlkoenig"))		  
+		  (let ((rest-arc-2
+			 (loop for item across (dom:child-nodes (elt node-2s 0))
+			    when (let ((node-ns (dom:namespace-uri item))
+				       (node-name (rdf-importer::get-node-name item))
+				       (nodeID (rdf-importer::get-ns-attribute
+						item "nodeID")))
+				   (and (string= node-ns *rdf-ns*)
+					(string= node-name "rest")
+					nodeID))
+		      return item)))
+		    (is-true rest-arc-2)
+		    (let ((id-3 (rdf-importer::get-ns-attribute rest-arc-2
+								"nodeID")))
+		      (let ((node-3s (get-resources-by-id id-3)))
+			(is (= (length node-3s) 1))
+			(is (= (length (dom:child-nodes (elt node-3s 0))) 2))
+			(is-true (property-p
+				  (elt node-3s 0) *rdf-ns* "first"
+				  :resource
+				  "http://some.where/poem/Prometheus"))
+			(is-true
+			 (property-p 
+			  (elt node-3s 0) *rdf-ns* "rest"
+			  :resource
+			  (concatenate 'string *rdf-ns* "nil")))))))))))))))
+
+
+(test test-association
+  "Tests a TM association with four roles and one item-identifier."
+  (with-fixture rdf-exporter-test-db ()
+    (let ((assoc-id (elephant::oid
+		     (d:identified-construct 
+		      (elephant:get-instance-by-value 
+		       'd:ItemIdentifierC 'd:uri
+		       "http://some.where/test-association")))))
+      (is-true assoc-id)
+      (let ((assocs (get-resources-by-id
+		     (concatenate 'string "id_" (write-to-string assoc-id)))))
+	(is (= (length assocs)))
+	(let ((me (elt assocs 0)))
+	  (is (= (length (dom:child-nodes me)) 7))
+	  (is-true (type-p me (concatenate 'string *tm2rdf-ns* "Association")))
+	  (is-true (identifier-p me "http://some.where/test-association"))
+	  (is-true (property-p me *tm2rdf-ns* "associationtype"
+			       :resource (concatenate
+					  'string *sw-arc*
+					  "associatedWithEachOther")))
+	  (is-true (role-p me "http://some.where/roletype/writer"
+			   nil :player-uri "http://some.where/author/Goethe"))
+
+	  (let ((schiller-id (concatenate
+			      'string "id_"
+			      (write-to-string
+			       (elephant::oid
+				(d:topic
+				 (elephant:get-instance-by-value
+				  'd:OccurrenceC 'd:charvalue
+				  "http://de.wikipedia.org/wiki/Schiller")))))))
+	    (is-true (role-p me "http://some.where/roletype/writer"
+			     nil :player-id schiller-id)))
+	  (is-true (role-p me "http://some.where/roletype/literature"
+			   nil :player-uri "http://some.where/types/Poem"))
+	  (is-true (role-p me "http://some.where/roletype/literature"
+			   (list "http://some.where/test-role")
+			   :player-uri "http://some.where/types/Ballad")))))))
+
+
+
+
+(defun run-rdf-exporter-tests()
+  "Runs all test cases of this suite."
+  (when elephant:*store-controller*
+    (elephant:close-store))
+  (it.bese.fiveam:run! 'test-resources)
+  (it.bese.fiveam:run! 'test-goethe)
+  (it.bese.fiveam:run! 'test-erlkoenig)
+  (it.bese.fiveam:run! 'test-prometheus)
+  (it.bese.fiveam:run! 'test-zauberlehrling)
+  (it.bese.fiveam:run! 'test-frankfurt)
+  (it.bese.fiveam:run! 'test-weimar)
+  (it.bese.fiveam:run! 'test-berlin)
+  (it.bese.fiveam:run! 'test-region)
+  (it.bese.fiveam:run! 'test-city-and-metropolis)
+  (it.bese.fiveam:run! 'test-germany)
+  (it.bese.fiveam:run! 'test-german)
+  (it.bese.fiveam:run! 'test-born-event)
+  (it.bese.fiveam:run! 'test-died-event)
+  (it.bese.fiveam:run! 'test-dateRange-zauberlehrling)
+  (it.bese.fiveam:run! 'test-dateRange-erlkoenig)
+  (it.bese.fiveam:run! 'test-dateRange-prometheus)
+  (it.bese.fiveam:run! 'test-schiller)
+  (it.bese.fiveam:run! 'test-single-nodes)
+  (it.bese.fiveam:run! 'test-collection)
+  (it.bese.fiveam:run! 'test-association))
\ No newline at end of file



From lgiessmann at common-lisp.net  Thu Aug 27 14:34:22 2009
From: lgiessmann at common-lisp.net (Lukas Giessmann)
Date: Thu, 27 Aug 2009 10:34:22 -0400
Subject: [isidorus-cvs] r124 - trunk/src/unit_tests
Message-ID: <E1Mgg3S-0006Fo-Jc@common-lisp.net>

Author: lgiessmann
Date: Thu Aug 27 10:34:22 2009
New Revision: 124

Log:
json: updated isidorus, so it is possibiel to use the current cl-json module; fixed some unit tests for the json module which caused problems with the sbcl-slime-connection; updated some unit tests to the corresponding cl-json version

Modified:
   trunk/src/unit_tests/json_test.lisp

Modified: trunk/src/unit_tests/json_test.lisp
==============================================================================
--- trunk/src/unit_tests/json_test.lisp	(original)
+++ trunk/src/unit_tests/json_test.lisp	Thu Aug 27 10:34:22 2009
@@ -20,10 +20,23 @@
   (:export :test-to-json-string-topics
 	   :test-to-json-string-associations
 	   :test-to-json-string-fragments
-	   :test-get-fragment-values-from-json-list
+	   :test-get-fragment-values-from-json-list-general
+	   :test-get-fragment-values-from-json-list-names
+	   :test-get-fragment-values-from-json-list-occurrences
+	   :test-get-fragment-values-from-json-list-topicStubs
+	   :test-get-fragment-values-from-json-list-associations
 	   :run-json-tests
-	   :test-json-importer
-	   :test-json-importer-merge
+	   :test-json-importer-general-1
+	   :test-json-importer-general-2
+	   :test-json-importer-general-3
+	   :test-json-importer-topics-1
+	   :test-json-importer-topics-2
+	   :test-json-importer-topics-3
+	   :test-json-importer-topics-4
+	   :test-json-importer-associations
+	   :test-json-importer-merge-1
+	   :test-json-importer-merge-2
+	   :test-json-importer-merge-3
 	   :test-get-all-topic-psis))
 
 
@@ -36,6 +49,15 @@
 (in-suite json-tests)
 
 
+(defvar *t100-1* "{\"topic\":{\"id\":\"t970\",\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/standard/Common+Lisp\"],\"instanceOfs\":[[\"http://psi.egovpt.org/types/standard\"]],\"names\":[{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_n1\",\"http://www.egovpt.org/itemIdentifiers#t100_n1a\"],\"type\":null,\"scopes\":null,\"value\":\"Common Lisp\",\"variants\":[{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_n_v1\"],\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"],[\"http://psi.egovpt.org/types/long-name\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"Common-Lisp\"}}]}],\"occurrences\":[{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_o1\"],\"type\":[\"http://psi.egovpt.org/types/links\"],\"scopes\":null,\"resourceRef\":\"http://www.common-lisp.net/\",\"resourceData\":null}]},\"topicStubs\":[{\"id\":\"t220\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t3\",\"http://www.egovpt.org/itemIdentifiers#t3\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/standard\"]},{\"id\":\"t68\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"]},{\"id\":\"t284\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t50a\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/long-name\"]},{\"id\":\"t324\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t55\",\"http://psi.egovpt.org/itemIdentifiers#t55_1\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/links\"]}],\"associations\":null,\"tmIds\":[\"http://www.isidor.us/unittests/testtm\"]}")
+
+(defvar *t100-2* "{\"topic\":{\"id\":\"t945\",\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100\",\"http://www.egovpt.org/itemIdentifiers#t100_new\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/standard/Common+Lisp\"],\"instanceOfs\":[[\"http://psi.egovpt.org/types/standard\"]],\"names\":[{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_n1\"],\"type\":null,\"scopes\":null,\"value\":\"Common Lisp\",\"variants\":[{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_n_v1\"],\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"],[\"http://psi.egovpt.org/types/long-name\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"Common-Lisp\"}},{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_n_v2\"],\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#display\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"CL\"}}]}],\"occurrences\":[{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_o2\"],\"type\":[\"http://psi.egovpt.org/types/links\"],\"scopes\":null,\"resourceRef\":\"http://www.cliki.net/\",\"resourceData\":null}]},\"topicStubs\":[{\"id\":\"t220\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t3\",\"http://www.egovpt.org/itemIdentifiers#t3\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/standard\"]},{\"id\":\"t68\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"]},{\"id\":\"t284\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t50a\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/long-name\"]},{\"id\":\"t74\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm#display\"]},{\"id\":\"t324\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t55\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/links\"]}],\"associations\":null,\"tmIds\":[\"http://www.isidor.us/unittests/testtm\"]}")
+
+(defvar *t100-3* "{\"topic\":{\"id\":\"t404\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata\"],\"instanceOfs\":[[\"http://psi.egovpt.org/types/semanticstandard\"]],\"names\":[{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_n1\"],\"type\":null,\"scopes\":null,\"value\":\"ISO 19115\",\"variants\":[{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_n1_v1\"],\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#display\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"Geographic Information - Metadata\"}},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_n1_v2\"],\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"ISO-19115\"}}]}],\"occurrences\":[{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_o1\"],\"type\":[\"http://psi.egovpt.org/types/standardHasStatus\"],\"scopes\":null,\"resourceRef\":\"http://www.budabe.de/\",\"resourceData\":null},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_o2\"],\"type\":[\"http://psi.egovpt.org/types/description\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"The ISO 19115 standard ...\"}},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_o3\"],\"type\":[\"http://psi.egovpt.org/types/standardValidFromDate\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#date\",\"value\":\"2003-01-01\"}},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_o4\"],\"type\":[\"http://psi.egovpt.org/types/links\"],\"scopes\":null,\"resourceRef\":\"http://www.editeur.org/standards/ISO19115.pdf\",\"resourceData\":null}]},\"topicStubs\":[{\"id\":\"t228\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t3a\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/semanticstandard\"]},{\"id\":\"t74\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm#display\"]},{\"id\":\"t68\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"]},{\"id\":\"t292\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t51\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/standardHasStatus\"]},{\"id\":\"t308\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t53\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/description\"]},{\"id\":\"t316\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t54\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/standardValidFromDate\"]},{\"id\":\"t324\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t55\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/links\"]},{\"id\":\"t434\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/subject/GeoData\"]},{\"id\":\"t364\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t60\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/standardIsAboutSubject\"]},{\"id\":\"t372\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t61\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/SubjectRoleType\"]},{\"id\":\"t422\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/subject/Semantic+Description\"]},{\"id\":\"t396\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t64\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/serviceUsesStandard\"]},{\"id\":\"t388\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t63\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/ServiceRoleType\"]},{\"id\":\"t452\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/service/Google+Maps\",\"http://maps.google.com\"]},{\"id\":\"t380\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t62\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/StandardRoleType\"]}],\"associations\":[{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/standardIsAboutSubject\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/StandardRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata\"]},{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/SubjectRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/subject/GeoData\"]}]},{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/standardIsAboutSubject\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/StandardRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata\"]},{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/SubjectRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/subject/Semantic+Description\"]}]},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#assoc_7\"],\"type\":[\"http://psi.egovpt.org/types/serviceUsesStandard\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/ServiceRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/service/Google+Maps\",\"http://maps.google.com\"]},{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/StandardRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata\"]}]}],\"tmIds\":[\"http://www.isidor.us/unittests/testtm\"]}")
+
+(defvar *t64* "{\"topic\":{\"id\":\"t396\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t64\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/serviceUsesStandard\"],\"instanceOfs\":[[\"http://www.networkedplanet.com/psi/npcl/meta-types/association-type\"]],\"names\":[{\"itemIdentities\":null,\"type\":null,\"scopes\":null,\"value\":\"service uses standard\",\"variants\":null}],\"occurrences\":null},\"topicStubs\":[{\"id\":\"t260\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t7\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.networkedplanet.com/psi/npcl/meta-types/association-type\"]}],\"associations\":null,\"tmIds\":[\"http://www.isidor.us/unittests/testtm\"]}")
+
+
 (test test-to-json-string-topics
   (let
       ((dir "data_base"))
@@ -48,31 +70,30 @@
       (let ((t50a (get-item-by-id "t50a")))
 	(let ((t50a-string (to-json-string t50a))
 	      (json-string 
-	       (concatenate 'string "{\"id\":\"" (topicid t50a) "\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t50a\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/long-name\"],\"instanceOfs\":[[\"http://www.networkedplanet.com/psi/npcl/meta-types/occurrence-type\"]],\"names\":[{\"itemIdentities\":null,\"type\":null,\"scopes\":null,\"value\":\"long version of a name\",\"variants\":[{\"itemIdentities\":null,\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"Long-Version\"}}]}],\"occurrences\":null}" )))
+	       (concatenate 'string "{\"id\":\"" (topicid t50a) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t50a\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/long-name\"],\"instanceOfs\":[[\"http:\\/\\/www.networkedplanet.com\\/psi\\/npcl\\/meta-types\\/occurrence-type\"]],\"names\":[{\"itemIdentities\":null,\"type\":null,\"scopes\":null,\"value\":\"long version of a name\",\"variants\":[{\"itemIdentities\":null,\"scopes\":[[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#sort\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"Long-Version\"}}]}],\"occurrences\":null}" )))
 	  (is (string= t50a-string json-string)))
 	(let ((t8 (get-item-by-id "t8")))
 	  (let ((t8-string (to-json-string t8))
 		(json-string 
-		 (concatenate 'string "{\"id\":\"" (topicid t8) "\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t8\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.networkedplanet.com/psi/npcl/meta-types/association-role-type\"],\"instanceOfs\":[[\"http://www.networkedplanet.com/psi/npcl/meta-types/topic-type\"]],\"names\":[{\"itemIdentities\":null,\"type\":null,\"scopes\":null,\"value\":\"Association Role Type\",\"variants\":null}],\"occurrences\":null}")))
+		 (concatenate 'string "{\"id\":\"" (topicid t8) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t8\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/www.networkedplanet.com\\/psi\\/npcl\\/meta-types\\/association-role-type\"],\"instanceOfs\":[[\"http:\\/\\/www.networkedplanet.com\\/psi\\/npcl\\/meta-types\\/topic-type\"]],\"names\":[{\"itemIdentities\":null,\"type\":null,\"scopes\":null,\"value\":\"Association Role Type\",\"variants\":null}],\"occurrences\":null}")))
 	    (is (string= t8-string json-string))))
 	(let ((t-topic (get-item-by-id "topic" :xtm-id "core.xtm")))
 	  (let ((t-topic-string (to-json-string t-topic))
 		(json-string
-		 (concatenate 'string "{\"id\":\"" (topicid t-topic) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm#topic\"],\"instanceOfs\":null,\"names\":null,\"occurrences\":null}")))
+		 (concatenate 'string "{\"id\":\"" (topicid t-topic) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#topic\"],\"instanceOfs\":null,\"names\":null,\"occurrences\":null}")))
 	    (is (string= t-topic-string json-string))))
 	(let ((t301 (get-item-by-id "t301")))
 	  (let ((t301-string (to-json-string t301))
 		(json-string
-		 (concatenate 'string "{\"id\":\"" (topicid t301) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/service/Google+Maps\",\"http://maps.google.com\"],\"instanceOfs\":[[\"http://psi.egovpt.org/types/service\"]],\"names\":[{\"itemIdentities\":[\"http://psi.egovpt.org/topic/t301a_n1\"],\"type\":null,\"scopes\":[[\"http://psi.egovpt.org/types/long-name\"]],\"value\":\"Google Maps\",\"variants\":null},{\"itemIdentities\":null,\"type\":null,\"scopes\":[[\"http://psi.egovpt.org/types/long-name\"]],\"value\":\"Google Maps Application\",\"variants\":null}],\"occurrences\":[{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/description\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"a popular geodata service that is widely used for mashups with geodataProbably not really conformant to ISO 19115, but who cares in this context.\"}},{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/links\"],\"scopes\":null,\"resourceRef\":\"http://maps.google.com\",\"resourceData\":null},{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/links\"],\"scopes\":null,\"resourceRef\":\"http://maps.google.de\",\"resourceData\":null}]}")))
+		 (concatenate 'string "{\"id\":\"" (topicid t301) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/service\\/Google+Maps\",\"http:\\/\\/maps.google.com\"],\"instanceOfs\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/service\"]],\"names\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/topic\\/t301a_n1\"],\"type\":null,\"scopes\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/long-name\"]],\"value\":\"Google Maps\",\"variants\":null},{\"itemIdentities\":null,\"type\":null,\"scopes\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/long-name\"]],\"value\":\"Google Maps Application\",\"variants\":null}],\"occurrences\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/description\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"a popular geodata service that is widely used for mashups with geodataProbably not really conformant to ISO 19115, but who cares in this context.\"}},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/links\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/maps.google.com\",\"resourceData\":null},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/links\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/maps.google.de\",\"resourceData\":null}]}")))
 	    (is (string= t301-string json-string))))
 	(let ((t100 (get-item-by-id "t100")))
 	  (let ((t100-string (to-json-string t100))
 		(json-string
-		 (concatenate 'string "{\"id\":\"" (topicid t100) "\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata\"],\"instanceOfs\":[[\"http://psi.egovpt.org/types/semanticstandard\"]],\"names\":[{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_n1\"],\"type\":null,\"scopes\":null,\"value\":\"ISO 19115\",\"variants\":[{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_n1_v1\"],\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#display\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"Geographic Information - Metadata\"}},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_n1_v2\"],\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"ISO-19115\"}}]}],\"occurrences\":[{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_o1\"],\"type\":[\"http://psi.egovpt.org/types/standardHasStatus\"],\"scopes\":null,\"resourceRef\":\"http://www.budabe.de/\",\"resourceData\":null},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_o2\"],\"type\":[\"http://psi.egovpt.org/types/description\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"The ISO 19115 standard ...\"}},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_o3\"],\"type\":[\"http://psi.egovpt.org/types/standardValidFromDate\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#date\",\"value\":\"2003-01-01\"}},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_o4\"],\"type\":[\"http://psi.egovpt.org/types/links\"],\"scopes\":null,\"resourceRef\":\"http://www.editeur.org/standards/ISO19115.pdf\",\"resourceData\":null}]}")))
+		 (concatenate 'string "{\"id\":\"" (topicid t100) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"],\"instanceOfs\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/semanticstandard\"]],\"names\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1\"],\"type\":null,\"scopes\":null,\"value\":\"ISO 19115\",\"variants\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1_v1\"],\"scopes\":[[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#display\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"Geographic Information - Metadata\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1_v2\"],\"scopes\":[[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#sort\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"ISO-19115\"}}]}],\"occurrences\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o1\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardHasStatus\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/www.budabe.de\\/\",\"resourceData\":null},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o2\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/description\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"The ISO 19115 standard ...\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o3\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardValidFromDate\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#date\",\"value\":\"2003-01-01\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o4\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/links\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/www.editeur.org\\/standards\\/ISO19115.pdf\",\"resourceData\":null}]}")))
 	    (is (string= t100-string json-string))))))))
 
 
-
 (test test-to-json-string-associations
   (let
       ((dir "data_base"))
@@ -103,11 +124,11 @@
 						"http://psi.egovpt.org/itemIdentifiers#assoc_7"))))
 	  (let ((association-1-string (to-json-string association-1))
 		(json-string
-		 (concatenate 'string "{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/isNarrowerSubject\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/broaderSubject\"],\"topicRef\":[\"http://psi.egovpt.org/subject/Data\"]},{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/narrowerSubject\"],\"topicRef\":[\"http://psi.egovpt.org/subject/GeoData\"]}]}")))
+		 (concatenate 'string "{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/isNarrowerSubject\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/broaderSubject\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/subject\\/Data\"]},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/narrowerSubject\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/subject\\/GeoData\"]}]}")))
 	    (is (string= association-1-string json-string)))
 	  (let ((association-7-string (to-json-string association-7))
 		(json-string
-		 (concatenate 'string "{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#assoc_7\"],\"type\":[\"http://psi.egovpt.org/types/serviceUsesStandard\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/ServiceRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/service/Google+Maps\",\"http://maps.google.com\"]},{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/StandardRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata\"]}]}")))
+		 (concatenate 'string "{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#assoc_7\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/serviceUsesStandard\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/ServiceRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/service\\/Google+Maps\",\"http:\\/\\/maps.google.com\"]},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/StandardRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"]}]}")))
 	    (is (string= association-7-string json-string)))
 	  (elephant:remove-association association-7 'roles (first (roles association-7)))
 	  (elephant:remove-association association-7 'roles (first (roles association-7)))
@@ -116,11 +137,10 @@
 	  (elephant:add-association association-7 'themes t62)
 	  (let ((association-7-string (to-json-string association-7))
 		(json-string
-		 (concatenate 'string "{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#assoc_7\"],\"type\":null,\"scopes\":[[\"http://psi.egovpt.org/types/StandardRoleType\"],[\"http://psi.egovpt.org/types/serviceUsesStandard\"]],\"roles\":null}")))
+		 (concatenate 'string "{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#assoc_7\"],\"type\":null,\"scopes\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/StandardRoleType\"],[\"http:\\/\\/psi.egovpt.org\\/types\\/serviceUsesStandard\"]],\"roles\":null}")))
 	    (is (string= association-7-string json-string))))))))
 
 
-
 (test test-to-json-string-fragments
   (let
       ((dir "data_base"))
@@ -136,21 +156,20 @@
 	    (frag-topic
 	     (create-latest-fragment-of-topic "http://www.topicmaps.org/xtm/1.0/core.xtm#topic")))
 	(let ((frag-t100-string
-	       (concatenate 'string "{\"topic\":{\"id\":\"" (d:topicid (d:topic frag-t100)) "\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata\"],\"instanceOfs\":[[\"http://psi.egovpt.org/types/semanticstandard\"]],\"names\":[{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_n1\"],\"type\":null,\"scopes\":null,\"value\":\"ISO 19115\",\"variants\":[{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_n1_v1\"],\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#display\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"Geographic Information - Metadata\"}},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_n1_v2\"],\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"ISO-19115\"}}]}],\"occurrences\":[{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_o1\"],\"type\":[\"http://psi.egovpt.org/types/standardHasStatus\"],\"scopes\":null,\"resourceRef\":\"http://www.budabe.de/\",\"resourceData\":null},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_o2\"],\"type\":[\"http://psi.egovpt.org/types/description\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"The ISO 19115 standard ...\"}},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_o3\"],\"type\":[\"http://psi.egovpt.org/types/standardValidFromDate\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#date\",\"value\":\"2003-01-01\"}},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_o4\"],\"type\":[\"http://psi.egovpt.org/types/links\"],\"scopes\":null,\"resourceRef\":\"http://www.editeur.org/standards/ISO19115.pdf\",\"resourceData\":null}]},\"topicStubs\":[{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 0)) "\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t3a\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/semanticstandard\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 1)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm#display\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 2)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 3)) "\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t51\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/standardHasStatus\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 4)) "\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t53\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/description\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 5)) "\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t54\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/standardValidFromDate\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 6)) "\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t55\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/links\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 7)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/subject/GeoData\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 8)) "\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t60\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/standardIsAboutSubject\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 9)) "\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t61\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/SubjectRoleType\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 10)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/subject/Semantic+Description\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 11)) "\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t64\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/serviceUsesStandard\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 12)) "\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t63\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/ServiceRoleType\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 13)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/service/Google+Maps\",\"http://maps.google.com\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 14)) "\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t62\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/StandardRoleType\"]}],\"associations\":[{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/standardIsAboutSubject\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/StandardRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata\"]},{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/SubjectRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/subject/GeoData\"]}]},{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/standardIsAboutSubject\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/StandardRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata\"]},{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/SubjectRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/subject/Semantic+Description\"]}]},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#assoc_7\"],\"type\":[\"http://psi.egovpt.org/types/serviceUsesStandard\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/ServiceRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/service/Google+Maps\",\"http://maps.google.com\"]},{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/StandardRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata\"]}]}],\"tmIds\":[\"http://www.isidor.us/unittests/testtm\"]}"))
+	       (concatenate 'string "{\"topic\":{\"id\":\"" (d:topicid (d:topic frag-t100)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"],\"instanceOfs\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/semanticstandard\"]],\"names\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1\"],\"type\":null,\"scopes\":null,\"value\":\"ISO 19115\",\"variants\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1_v1\"],\"scopes\":[[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#display\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"Geographic Information - Metadata\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1_v2\"],\"scopes\":[[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#sort\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"ISO-19115\"}}]}],\"occurrences\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o1\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardHasStatus\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/www.budabe.de\\/\",\"resourceData\":null},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o2\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/description\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"The ISO 19115 standard ...\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o3\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardValidFromDate\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#date\",\"value\":\"2003-01-01\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o4\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/links\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/www.editeur.org\\/standards\\/ISO19115.pdf\",\"resourceData\":null}]},\"topicStubs\":[{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 0)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t3a\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/semanticstandard\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 1)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#display\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 2)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#sort\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 3)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t51\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardHasStatus\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 4)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t53\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/description\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 5)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t54\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardValidFromDate\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 6)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t55\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/links\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 7)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/subject\\/GeoData\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 8)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t60\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardIsAboutSubject\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 9)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t61\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/SubjectRoleType\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 10)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/subject\\/Semantic+Description\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 11)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t64\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/serviceUsesStandard\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 12)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t63\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/ServiceRoleType\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 13)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/service\\/Google+Maps\",\"http:\\/\\/maps.google.com\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 14)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t62\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/StandardRoleType\"]}],\"associations\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardIsAboutSubject\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/StandardRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"]},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/SubjectRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/subject\\/GeoData\"]}]},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardIsAboutSubject\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/StandardRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"]},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/SubjectRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/subject\\/Semantic+Description\"]}]},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#assoc_7\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/serviceUsesStandard\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/ServiceRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/service\\/Google+Maps\",\"http:\\/\\/maps.google.com\"]},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/StandardRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"]}]}],\"tmIds\":[\"http:\\/\\/www.isidor.us\\/unittests\\/testtm\"]}"))
 	      (frag-topic-string
-	       (concatenate 'string "{\"topic\":{\"id\":\"" (topicid (topic frag-topic)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm#topic\"],\"instanceOfs\":null,\"names\":null,\"occurrences\":null},\"topicStubs\":null,\"associations\":null,\"tmIds\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm\"]}")))
+	       (concatenate 'string "{\"topic\":{\"id\":\"" (topicid (topic frag-topic)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#topic\"],\"instanceOfs\":null,\"names\":null,\"occurrences\":null},\"topicStubs\":null,\"associations\":null,\"tmIds\":[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm\"]}")))
 	  (is (string= frag-t100-string (to-json-string frag-t100)))
 	  (is (string= frag-topic-string (to-json-string frag-topic))))))))
 
 
-
-(test test-get-fragment-values-from-json-list
+(test test-get-fragment-values-from-json-list-general
   (let
       ((dir "data_base"))
     (with-fixture initialize-destination-db (dir)
       (xml-importer:setup-repository
        *notificationbase.xtm* dir :tm-id "http://www.isidor.us/unittests/testtm"
-                                  :xtm-id *TEST-TM*)
+       :xtm-id *TEST-TM*)
       
       (elephant:open-store (xml-importer:get-store-spec dir))
       (let ((json-fragment
@@ -160,22 +179,39 @@
 	(let ((fragment-list
 	       (json-importer::get-fragment-values-from-json-list
 		(json:decode-json-from-string json-fragment))))
-	  (let ((topic (getf fragment-list :topic))
-		(topicStubs (getf fragment-list :topicStubs))
-		(f-associations (getf fragment-list :associations)))
+	  (let ((topic (getf fragment-list :topic)))
 	    (is (string= (getf topic :ID)
 			 (d:topicid
 			  (d:identified-construct (elephant:get-instance-by-value 'd:PersistentIdC 'd:uri
-							  "http://psi.egovpt.org/standard/Topic+Maps+2002")))))
+										  "http://psi.egovpt.org/standard/Topic+Maps+2002")))))
 	    (is-false (getf topic :itemIdentities))
 	    (is-false (getf topic :subjectLocators))
 	    (is (= (length (getf topic :subjectIdentifiers)) 1))
-	    (is (string= (first (getf topic :subjectIdentifiers)) 
+	    (is (string= (first (getf topic :subjectIdentifiers))
 			 "http://psi.egovpt.org/standard/Topic+Maps+2002"))
-	    (is (= (length (getf topic :instanceOfs)) 1))
-	    (is (= (length (first (getf topic :instanceOfs))) 1))
-	    (is (string= (first (first (getf topic :instanceOfs)))
-			 "http://psi.egovpt.org/types/semanticstandard"))
+	            (is (= (length (getf topic :instanceOfs)) 1))
+	            (is (= (length (first (getf topic :instanceOfs))) 1))
+	            (is (string= (first (first (getf topic :instanceOfs)))
+	                         "http://psi.egovpt.org/types/semanticstandard"))))))))
+
+
+(test test-get-fragment-values-from-json-list-names
+  (let
+      ((dir "data_base"))
+    (with-fixture initialize-destination-db (dir)
+      (xml-importer:setup-repository
+       *notificationbase.xtm* dir :tm-id "http://www.isidor.us/unittests/testtm"
+                                  :xtm-id *TEST-TM*)
+      
+      (elephant:open-store (xml-importer:get-store-spec dir))
+      (let ((json-fragment
+	     (let ((fragment-obj
+		    (create-latest-fragment-of-topic "http://psi.egovpt.org/standard/Topic+Maps+2002")))
+	       (to-json-string fragment-obj))))
+	(let ((fragment-list
+	       (json-importer::get-fragment-values-from-json-list
+		(json:decode-json-from-string json-fragment))))
+	  (let ((topic (getf fragment-list :topic)))
 	    (is (= (length (getf topic :names)) 2))
 	    (let ((name-1 (first (getf topic :names)))
 		  (name-2 (second (getf topic :names))))
@@ -223,8 +259,27 @@
 		(is (string= (getf (getf variant :resourceData) :datatype)
 			     "http://www.w3.org/2001/XMLSchema#string"))
 		(is (string= (getf (getf variant :resourceData) :value)
-			     "ISO/IEC-13250:2002"))
-		(is (= (length (getf topic :occurrences)) 4))))
+			     "ISO/IEC-13250:2002"))))))))))
+
+
+(test test-get-fragment-values-from-json-list-occurrences
+  (let
+      ((dir "data_base"))
+    (with-fixture initialize-destination-db (dir)
+      (xml-importer:setup-repository
+       *notificationbase.xtm* dir :tm-id "http://www.isidor.us/unittests/testtm"
+                                  :xtm-id *TEST-TM*)
+      
+      (elephant:open-store (xml-importer:get-store-spec dir))
+      (let ((json-fragment
+	     (let ((fragment-obj
+		    (create-latest-fragment-of-topic "http://psi.egovpt.org/standard/Topic+Maps+2002")))
+	       (to-json-string fragment-obj))))
+	(let ((fragment-list
+	       (json-importer::get-fragment-values-from-json-list
+		(json:decode-json-from-string json-fragment))))
+	  (let ((topic (getf fragment-list :topic)))
+	    (is (= (length (getf topic :occurrences)) 4))
 	    (let ((occurrence-1 (first (getf topic :occurrences)))
 		  (occurrence-2 (second (getf topic :occurrences)))
 		  (occurrence-3 (third (getf topic :occurrences)))
@@ -267,7 +322,26 @@
 	      (is-false (getf occurrence-4 :scopes))
 	      (is (string= (getf occurrence-4 :resourceRef)
 			   "http://www1.y12.doe.gov/capabilities/sgml/sc34/document/0322_files/iso13250-2nd-ed-v2.pdf"))
-	      (is-false (getf occurrence-4 :resourceData)))
+	      (is-false (getf occurrence-4 :resourceData)))))))))
+
+
+(test test-get-fragment-values-from-json-list-topicStubs
+  (let
+      ((dir "data_base"))
+    (with-fixture initialize-destination-db (dir)
+      (xml-importer:setup-repository
+       *notificationbase.xtm* dir :tm-id "http://www.isidor.us/unittests/testtm"
+                                  :xtm-id *TEST-TM*)
+      
+      (elephant:open-store (xml-importer:get-store-spec dir))
+      (let ((json-fragment
+	     (let ((fragment-obj
+		    (create-latest-fragment-of-topic "http://psi.egovpt.org/standard/Topic+Maps+2002")))
+	       (to-json-string fragment-obj))))
+	(let ((fragment-list
+	       (json-importer::get-fragment-values-from-json-list
+		(json:decode-json-from-string json-fragment))))
+	  (let ((topicStubs (getf fragment-list :topicStubs)))		
 	    (is (= (length topicStubs) 15))
 	    (loop for topicStub in topicStubs
 	       do (let ((id (getf topicStub :ID))
@@ -340,7 +414,27 @@
 			   (is (string= (first itemIdentities)
 					"http://psi.egovpt.org/itemIdentifiers#t52")))
 			  (t
-			   (is-true (format t "bad subjectIdentifier found in topicStubs"))))))))
+			   (is-true (format t "bad subjectIdentifier found in topicStubs"))))))))))))))
+
+
+
+(test test-get-fragment-values-from-json-list-associations
+  (let
+      ((dir "data_base"))
+    (with-fixture initialize-destination-db (dir)
+      (xml-importer:setup-repository
+       *notificationbase.xtm* dir :tm-id "http://www.isidor.us/unittests/testtm"
+                                  :xtm-id *TEST-TM*)
+      
+      (elephant:open-store (xml-importer:get-store-spec dir))
+      (let ((json-fragment
+	     (let ((fragment-obj
+		    (create-latest-fragment-of-topic "http://psi.egovpt.org/standard/Topic+Maps+2002")))
+	       (to-json-string fragment-obj))))
+	(let ((fragment-list
+	       (json-importer::get-fragment-values-from-json-list
+		(json:decode-json-from-string json-fragment))))
+	  (let ((f-associations (getf fragment-list :associations)))
 	    (is (= (length f-associations) 2))
 	    (is (= (length (getf (first f-associations) :type)) 1))
 	    (is (= (length (getf (second f-associations) :type)) 1))
@@ -396,147 +490,192 @@
 			     "http://psi.egovpt.org/standard/Topic+Maps+2002"))))))))))
 
 
-(test test-json-importer
+(test test-json-importer-general-1
   (let
       ((dir "data_base"))
     (with-fixture initialize-destination-db (dir)
       (elephant:open-store (xml-importer:get-store-spec dir))
       (xml-importer:init-isidorus)
       (elephant:open-store (xml-importer:get-store-spec dir)) ; init-isiodurs closes the store
-      
-      (let ((json-fragment-t64 
-	     "{\"topic\":{\"id\":\"t396\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t64\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/serviceUsesStandard\"],\"instanceOfs\":[[\"http://www.networkedplanet.com/psi/npcl/meta-types/association-type\"]],\"names\":[{\"itemIdentities\":null,\"type\":null,\"scopes\":null,\"value\":\"service uses standard\",\"variants\":null}],\"occurrences\":null},\"topicStubs\":[{\"id\":\"t260\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t7\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.networkedplanet.com/psi/npcl/meta-types/association-type\"]}],\"associations\":null,\"tmIds\":[\"http://www.isidor.us/unittests/testtm\"]}")
-	    (json-fragment-t100
-	     "{\"topic\":{\"id\":\"t404\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata\"],\"instanceOfs\":[[\"http://psi.egovpt.org/types/semanticstandard\"]],\"names\":[{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_n1\"],\"type\":null,\"scopes\":null,\"value\":\"ISO 19115\",\"variants\":[{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_n1_v1\"],\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#display\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"Geographic Information - Metadata\"}},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_n1_v2\"],\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"ISO-19115\"}}]}],\"occurrences\":[{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_o1\"],\"type\":[\"http://psi.egovpt.org/types/standardHasStatus\"],\"scopes\":null,\"resourceRef\":\"http://www.budabe.de/\",\"resourceData\":null},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_o2\"],\"type\":[\"http://psi.egovpt.org/types/description\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"The ISO 19115 standard ...\"}},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_o3\"],\"type\":[\"http://psi.egovpt.org/types/standardValidFromDate\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#date\",\"value\":\"2003-01-01\"}},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_o4\"],\"type\":[\"http://psi.egovpt.org/types/links\"],\"scopes\":null,\"resourceRef\":\"http://www.editeur.org/standards/ISO19115.pdf\",\"resourceData\":null}]},\"topicStubs\":[{\"id\":\"t228\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t3a\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/semanticstandard\"]},{\"id\":\"t74\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm#display\"]},{\"id\":\"t68\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"]},{\"id\":\"t292\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t51\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/standardHasStatus\"]},{\"id\":\"t308\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t53\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/description\"]},{\"id\":\"t316\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t54\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/standardValidFromDate\"]},{\"id\":\"t324\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t55\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/links\"]},{\"id\":\"t434\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/subject/GeoData\"]},{\"id\":\"t364\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t60\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/standardIsAboutSubject\"]},{\"id\":\"t372\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t61\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/SubjectRoleType\"]},{\"id\":\"t422\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/subject/Semantic+Description\"]},{\"id\":\"t396\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t64\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/serviceUsesStandard\"]},{\"id\":\"t388\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t63\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/ServiceRoleType\"]},{\"id\":\"t452\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/service/Google+Maps\",\"http://maps.google.com\"]},{\"id\":\"t380\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t62\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/StandardRoleType\"]}],\"associations\":[{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/standardIsAboutSubject\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/StandardRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata\"]},{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/SubjectRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/subject/GeoData\"]}]},{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/standardIsAboutSubject\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/StandardRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata\"]},{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/SubjectRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/subject/Semantic+Description\"]}]},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#assoc_7\"],\"type\":[\"http://psi.egovpt.org/types/serviceUsesStandard\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/ServiceRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/service/Google+Maps\",\"http://maps.google.com\"]},{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/StandardRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata\"]}]}],\"tmIds\":[\"http://www.isidor.us/unittests/testtm\"]}"))
-	(is (= (length (elephant:get-instances-by-class 'TopicC)) 13))
-	(is (= (length (elephant:get-instances-by-class 'AssociationC)) 0))
-	(is (= (length (elephant:get-instances-by-class 'TopicMapC)) 1))
-	(json-importer:json-to-elem json-fragment-t64)
-	(is (= (length (elephant:get-instances-by-class 'TopicC)) 15))
-	(is (= (length (elephant:get-instances-by-class 'AssociationC)) 1))
-	(is (= (length (elephant:get-instances-by-class 'TopicMapC)) 2))
-	(let ((core-tm
-	       (loop for tm in (elephant:get-instances-by-class 'TopicMapC)
-		  when (string= (uri (first (item-identifiers tm)))
-				"http://www.topicmaps.org/xtm/1.0/core.xtm")
-		  return tm))	      
-	      (test-tm
-	       (loop for tm in (elephant:get-instances-by-class 'TopicMapC)
-		  when (string= (uri (first (item-identifiers tm)))
-				"http://www.isidor.us/unittests/testtm")
-		  return tm)))
-	  (is-true (and core-tm test-tm))
-	  (is (= (length (topics core-tm)) 13))
-	  (is (= (length (associations core-tm)) 0))
-	  (is (= (length (topics test-tm)) 2))
-	  (is (= (length (associations test-tm)) 1))
-	  (let ((main-topic
-		 (loop for topic in (topics test-tm)
-		    when (string= (uri (first (psis topic)))
-				  "http://psi.egovpt.org/types/serviceUsesStandard")
-		    return topic))
-		(sub-topic
-		 (loop for topic in (topics test-tm)
-		    when (string= (uri (first (psis topic)))
-				  "http://www.networkedplanet.com/psi/npcl/meta-types/association-type")
-		    return topic)))
-	    (is-true (and main-topic sub-topic))
-	    (let ((instanceOf-assoc
-		   (first (associations test-tm))))
-	      (is (string= (uri (first (psis (instance-of instanceOf-assoc))))
-			   constants::*type-instance-psi*))
-	      (is-false (d:themes instanceOf-assoc))
-	      (is (string= (d:uri (first (d:item-identifiers (first (d:in-topicmaps instanceOf-assoc)))))
-			   "http://www.isidor.us/unittests/testtm"))
-	      (is-false (d:item-identifiers instanceOf-assoc))
-	      (let ((super-type-role
-		     (loop for role in (roles instanceOf-assoc)
-			when (string= (uri (first (psis (instance-of role))))
-				      constants:*type-psi*)
-			return role))
-		    (sub-type-role
-		     (loop for role in (roles instanceOf-assoc)
-			when (string= (uri (first (psis (instance-of role))))
-				      constants:*instance-psi*)
-			return role)))
-		(is-true (and super-type-role sub-type-role))
-		(is (string= (uri (first (psis (player super-type-role))))
-			     "http://www.networkedplanet.com/psi/npcl/meta-types/association-type"))
-		(is (string= (uri (first (psis (player sub-type-role))))
-			     "http://psi.egovpt.org/types/serviceUsesStandard"))))
-	    (is-true (= (length (item-identifiers main-topic)) 1))
-	    (is-true (= (length (item-identifiers sub-topic)) 1))
-	    (is-true (string= (uri (first (item-identifiers main-topic)))
-			      "http://psi.egovpt.org/itemIdentifiers#t64"))
-	    (is-true (string= (uri (first (item-identifiers sub-topic)))
-			      "http://psi.egovpt.org/itemIdentifiers#t7"))
-	    (is-true (= (length (names main-topic)) 1))
-	    (is-true (string= (charvalue (first (names main-topic)))
-			      "service uses standard"))))
-	(json-importer:json-to-elem json-fragment-t100)
-	(is (= (length (elephant:get-instances-by-class 'TopicC)) 28)) ;13 new topics
-	(is (= (length (elephant:get-instances-by-class 'AssociationC)) 5)) ;4 new associations
-	(is (= (length (elephant:get-instances-by-class 'TopicMapC)) 2))
-	(let ((core-tm
-	       (loop for tm in (elephant:get-instances-by-class 'TopicMapC)
-		  when (string= (uri (first (item-identifiers tm)))
-				"http://www.topicmaps.org/xtm/1.0/core.xtm")
-		  return tm))	      
-	      (test-tm
+      (is (= (length (elephant:get-instances-by-class 'TopicC)) 13))
+      (is (= (length (elephant:get-instances-by-class 'AssociationC)) 0))
+      (is (= (length (elephant:get-instances-by-class 'TopicMapC)) 1))
+      (json-importer:json-to-elem *t64*)
+      (is (= (length (elephant:get-instances-by-class 'TopicC)) 15))
+      (is (= (length (elephant:get-instances-by-class 'AssociationC)) 1))
+      (is (= (length (elephant:get-instances-by-class 'TopicMapC)) 2))
+      (let ((core-tm
+	     (loop for tm in (elephant:get-instances-by-class 'TopicMapC)
+		when (string= (uri (first (item-identifiers tm)))
+			      "http://www.topicmaps.org/xtm/1.0/core.xtm")
+		return tm))	      
+	    (test-tm
+	     (loop for tm in (elephant:get-instances-by-class 'TopicMapC)
+		when (string= (uri (first (item-identifiers tm)))
+			      "http://www.isidor.us/unittests/testtm")
+		return tm)))
+	(is-true (and core-tm test-tm))
+	(is (= (length (topics core-tm)) 13))
+	(is (= (length (associations core-tm)) 0))
+	(is (= (length (topics test-tm)) 2))
+	(is (= (length (associations test-tm)) 1))))))
+
+
+(test test-json-importer-general-2
+  (let
+      ((dir "data_base"))
+    (with-fixture initialize-destination-db (dir)
+      (elephant:open-store (xml-importer:get-store-spec dir))
+      (xml-importer:init-isidorus)
+      (elephant:open-store (xml-importer:get-store-spec dir)) ; init-isiodurs closes the store
+      (json-importer:json-to-elem *t64*)
+      (let ((test-tm
 	       (loop for tm in (elephant:get-instances-by-class 'TopicMapC)
 		  when (string= (uri (first (item-identifiers tm)))
 				"http://www.isidor.us/unittests/testtm")
 		  return tm)))
-	  (is-true (and core-tm test-tm))
-	  (is (= (length (topics core-tm)) 13))
-	  (is (= (length (associations core-tm)) 0))
-	  (is (= (length (topics test-tm)) 17))
-	  (is (= (length (associations test-tm)) 5))
-	  (let ((topics (elephant:get-instances-by-class 'TopicC)))
-	    (loop for topic in topics
-	       do (let ((psi (uri (first (psis topic)))))
-		    (cond
-		      ((string= psi "http://psi.egovpt.org/types/semanticstandard") ;t3a
-		       (is-false (names topic))
-		       (is-false (occurrences topic))
-		       (is-false (locators topic))
-		       (is (= (length (psis topic)) 1))
-		       (is (= (length (item-identifiers topic)) 1))
-		       (is (string= (uri (first (item-identifiers topic)))
-				    "http://psi.egovpt.org/itemIdentifiers#t3a")))
-		      ((string= psi "http://www.networkedplanet.com/psi/npcl/meta-types/association-type") ;t7
-		       (is-false (names topic))
-		       (is-false (occurrences topic))
-		       (is-false (locators topic))
-		       (is (= (length (psis topic)) 1))
-		       (is (= (length (item-identifiers topic)) 1))
-		       (is (string= (uri (first (item-identifiers topic)))
-				    "http://psi.egovpt.org/itemIdentifiers#t7")))
-		      ((string= psi "http://psi.egovpt.org/types/standardHasStatus") ;t51
-		     (is-false (names topic))
-		       (is-false (occurrences topic))
-		       (is-false (locators topic))
-		       (is (= (length (psis topic)) 1))
-		       (is (= (length (item-identifiers topic)) 1))
-		       (is (string= (uri (first (item-identifiers topic)))
-				    "http://psi.egovpt.org/itemIdentifiers#t51")))
-		      ((string= psi "http://psi.egovpt.org/types/description") ;t53
-		       (is-false (names topic))
-		       (is-false (occurrences topic))
-		       (is-false (locators topic))
-		       (is (= (length (psis topic)) 1))
-		       (is (= (length (item-identifiers topic)) 1))
-		       (is (string= (uri (first (item-identifiers topic)))
-				    "http://psi.egovpt.org/itemIdentifiers#t53")))
-		      ((string= psi "http://psi.egovpt.org/types/standardValidFromDate") ;t54
+	(let ((main-topic
+	       (loop for topic in (topics test-tm)
+		  when (string= (uri (first (psis topic)))
+				"http://psi.egovpt.org/types/serviceUsesStandard")
+		  return topic))
+	      (sub-topic
+	       (loop for topic in (topics test-tm)
+		  when (string= (uri (first (psis topic)))
+				"http://www.networkedplanet.com/psi/npcl/meta-types/association-type")
+		  return topic)))
+	  (is-true (and main-topic sub-topic))
+	  (let ((instanceOf-assoc
+		 (first (associations test-tm))))
+	    (is (string= (uri (first (psis (instance-of instanceOf-assoc))))
+			 constants::*type-instance-psi*))
+	    (is-false (d:themes instanceOf-assoc))
+	    (is (string= (d:uri (first (d:item-identifiers (first (d:in-topicmaps instanceOf-assoc)))))
+			 "http://www.isidor.us/unittests/testtm"))
+	    (is-false (d:item-identifiers instanceOf-assoc))
+	    (let ((super-type-role
+		   (loop for role in (roles instanceOf-assoc)
+		      when (string= (uri (first (psis (instance-of role))))
+				    constants:*type-psi*)
+		      return role))
+		  (sub-type-role
+		   (loop for role in (roles instanceOf-assoc)
+		      when (string= (uri (first (psis (instance-of role))))
+				    constants:*instance-psi*)
+		      return role)))
+	      (is-true (and super-type-role sub-type-role))
+	      (is (string= (uri (first (psis (player super-type-role))))
+			   "http://www.networkedplanet.com/psi/npcl/meta-types/association-type"))
+	      (is (string= (uri (first (psis (player sub-type-role))))
+			   "http://psi.egovpt.org/types/serviceUsesStandard"))))
+	  (is-true (= (length (item-identifiers main-topic)) 1))
+	  (is-true (= (length (item-identifiers sub-topic)) 1))
+	  (is-true (string= (uri (first (item-identifiers main-topic)))
+			    "http://psi.egovpt.org/itemIdentifiers#t64"))
+	  (is-true (string= (uri (first (item-identifiers sub-topic)))
+			    "http://psi.egovpt.org/itemIdentifiers#t7"))
+	  (is-true (= (length (names main-topic)) 1))
+	  (is-true (string= (charvalue (first (names main-topic)))
+			    "service uses standard")))))))
+
+
+(test test-json-importer-general-3
+  (let
+      ((dir "data_base"))
+    (with-fixture initialize-destination-db (dir)
+      (elephant:open-store (xml-importer:get-store-spec dir))
+      (xml-importer:init-isidorus)
+      (elephant:open-store (xml-importer:get-store-spec dir)) ; init-isiodurs closes the store
+      (json-importer:json-to-elem *t64*)
+      (json-importer:json-to-elem *t100-3*)
+      (is (= (length (elephant:get-instances-by-class 'TopicC)) 28)) ;13 new topics
+      (is (= (length (elephant:get-instances-by-class 'AssociationC)) 5)) ;4 new associations
+      (is (= (length (elephant:get-instances-by-class 'TopicMapC)) 2))
+      (let ((core-tm
+	     (loop for tm in (elephant:get-instances-by-class 'TopicMapC)
+		when (string= (uri (first (item-identifiers tm)))
+			      "http://www.topicmaps.org/xtm/1.0/core.xtm")
+		return tm))	      
+	    (test-tm
+	     (loop for tm in (elephant:get-instances-by-class 'TopicMapC)
+		when (string= (uri (first (item-identifiers tm)))
+			      "http://www.isidor.us/unittests/testtm")
+		return tm)))
+	(is-true (and core-tm test-tm))
+	(is (= (length (topics core-tm)) 13))
+	(is (= (length (associations core-tm)) 0))
+	(is (= (length (topics test-tm)) 17))
+	(is (= (length (associations test-tm)) 5))))))
+
+
+(test test-json-importer-topics-1
+  (let
+      ((dir "data_base"))
+    (with-fixture initialize-destination-db (dir)
+      (elephant:open-store (xml-importer:get-store-spec dir))
+      (xml-importer:init-isidorus)
+      (elephant:open-store (xml-importer:get-store-spec dir)) ; init-isiodurs closes the store
+      (json-importer:json-to-elem *t64*)
+      (json-importer:json-to-elem *t100-3*)
+      (let ((topics (elephant:get-instances-by-class 'TopicC)))
+	(loop for topic in topics
+	   do (let ((psi (uri (first (psis topic)))))
+		(cond
+		  ((string= psi "http://psi.egovpt.org/types/semanticstandard") ;t3a
+		   (is-false (names topic))
+		   (is-false (occurrences topic))
+		   (is-false (locators topic))
+		   (is (= (length (psis topic)) 1))
+		   (is (= (length (item-identifiers topic)) 1))
+		   (is (string= (uri (first (item-identifiers topic)))
+				"http://psi.egovpt.org/itemIdentifiers#t3a")))
+		  ((string= psi "http://www.networkedplanet.com/psi/npcl/meta-types/association-type") ;t7
+		   (is-false (names topic))
+		   (is-false (occurrences topic))
+		   (is-false (locators topic))
+		   (is (= (length (psis topic)) 1))
+		   (is (= (length (item-identifiers topic)) 1))
+		   (is (string= (uri (first (item-identifiers topic)))
+				"http://psi.egovpt.org/itemIdentifiers#t7")))
+		  ((string= psi "http://psi.egovpt.org/types/standardHasStatus") ;t51
+		   (is-false (names topic))
+		   (is-false (occurrences topic))
+		   (is-false (locators topic))
+		   (is (= (length (psis topic)) 1))
+		   (is (= (length (item-identifiers topic)) 1))
+		   (is (string= (uri (first (item-identifiers topic)))
+				"http://psi.egovpt.org/itemIdentifiers#t51")))
+		  ((string= psi "http://psi.egovpt.org/types/description") ;t53
+		   (is-false (names topic))
+		   (is-false (occurrences topic))
+		   (is-false (locators topic))
+		   (is (= (length (psis topic)) 1))
+		   (is (= (length (item-identifiers topic)) 1))
+		   (is (string= (uri (first (item-identifiers topic)))
+				"http://psi.egovpt.org/itemIdentifiers#t53")))
+		  ((string= psi "http://psi.egovpt.org/types/standardValidFromDate") ;t54
 		       (is-false (names topic))
 		       (is-false (occurrences topic))
 		       (is-false (locators topic))
 		       (is (= (length (psis topic)) 1))
 		       (is (= (length (item-identifiers topic)) 1))
 		       (is (string= (uri (first (item-identifiers topic)))
-				    "http://psi.egovpt.org/itemIdentifiers#t54")))
-		      ((string= psi "http://psi.egovpt.org/types/links") ;t55
+				    "http://psi.egovpt.org/itemIdentifiers#t54"))))))))))
+
+
+(test test-json-importer-topics-2
+  (let
+      ((dir "data_base"))
+    (with-fixture initialize-destination-db (dir)
+      (elephant:open-store (xml-importer:get-store-spec dir))
+      (xml-importer:init-isidorus)
+      (elephant:open-store (xml-importer:get-store-spec dir)) ; init-isiodurs closes the store
+      (json-importer:json-to-elem *t64*)
+      (json-importer:json-to-elem *t100-3*)
+      (let ((topics (elephant:get-instances-by-class 'TopicC)))
+	(loop for topic in topics
+	   do (let ((psi (uri (first (psis topic)))))
+		(cond ((string= psi "http://psi.egovpt.org/types/links") ;t55
 		       (is-false (names topic))
 		       (is-false (occurrences topic))
 		       (is-false (locators topic))
@@ -585,8 +724,22 @@
 		       (is (= (length (psis topic)) 1))
 		       (is (= (length (item-identifiers topic)) 1))
 		       (is (string= (uri (first (item-identifiers topic)))
-				    "http://psi.egovpt.org/itemIdentifiers#t64")))
-		      ((string= psi "http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata") ;t100
+				    "http://psi.egovpt.org/itemIdentifiers#t64"))))))))))
+
+
+(test test-json-importer-topics-3
+  (let
+      ((dir "data_base"))
+    (with-fixture initialize-destination-db (dir)
+      (elephant:open-store (xml-importer:get-store-spec dir))
+      (xml-importer:init-isidorus)
+      (elephant:open-store (xml-importer:get-store-spec dir)) ; init-isiodurs closes the store
+      (json-importer:json-to-elem *t64*)
+      (json-importer:json-to-elem *t100-3*)
+      (let ((topics (elephant:get-instances-by-class 'TopicC)))
+	(loop for topic in topics
+	   do (let ((psi (uri (first (psis topic)))))
+		(cond ((string= psi "http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata") ;t100
 		       (is (= (length (psis topic)) 1))
 		       (is (= (length (item-identifiers topic)) 1))
 		       (is (string= (uri (first (item-identifiers topic)))
@@ -660,8 +813,22 @@
 			 (is (string= (datatype occ-4)
 				      "http://www.w3.org/2001/XMLSchema#anyURI"))
 			 (is (string= (charvalue occ-4)
-				      "http://www.editeur.org/standards/ISO19115.pdf"))))
-		      ((string= psi "http://psi.egovpt.org/subject/Semantic+Description") ;t201
+				      "http://www.editeur.org/standards/ISO19115.pdf")))))))))))
+
+
+(test test-json-importer-topics-4
+  (let
+      ((dir "data_base"))
+    (with-fixture initialize-destination-db (dir)
+      (elephant:open-store (xml-importer:get-store-spec dir))
+      (xml-importer:init-isidorus)
+      (elephant:open-store (xml-importer:get-store-spec dir)) ; init-isiodurs closes the store
+      (json-importer:json-to-elem *t64*)
+      (json-importer:json-to-elem *t100-3*)
+      (let ((topics (elephant:get-instances-by-class 'TopicC)))
+	(loop for topic in topics
+	   do (let ((psi (uri (first (psis topic)))))
+		(cond ((string= psi "http://psi.egovpt.org/subject/Semantic+Description") ;t201
 		       (is-false (names topic))
 		       (is-false (occurrences topic))
 		       (is-false (locators topic))
@@ -687,256 +854,299 @@
 					"http://psi.egovpt.org/service/Google+Maps")
 			       (string= (uri (second (psis topic)))
 					"http://maps.google.com")))
-		       (is-false (item-identifiers topic)))
-		      (t
-		       (if (or (string= psi "http://www.topicmaps.org/xtm/1.0/core.xtm#sort")
-			       (string= psi "http://www.topicmaps.org/xtm/1.0/core.xtm#display"))
-			   (progn
-			     (is (= (length (in-topicmaps topic)) 2))
-			     (is (or (string= (uri (first (item-identifiers (first (in-topicmaps topic)))))
-					      "http://www.topicmaps.org/xtm/1.0/core.xtm")
-				     (string= (uri (first (item-identifiers (second (in-topicmaps topic)))))
-					      "http://www.topicmaps.org/xtm/1.0/core.xtm")))
-			     (is (or (string= (uri (first (item-identifiers (first (in-topicmaps topic)))))
-					      "http://www.isidor.us/unittests/testtm")
-				     (string= (uri (first (item-identifiers (second (in-topicmaps topic)))))
-					      "http://www.isidor.us/unittests/testtm"))))
-			   (progn
-			     (is (= (length (in-topicmaps topic)) 1))
-			     (is (string= (uri (first (item-identifiers (first (in-topicmaps topic)))))
-					  "http://www.topicmaps.org/xtm/1.0/core.xtm")))))))));
-	  (let ((assoc-7
-		 (identified-construct
-		  (elephant:get-instance-by-value 'ItemidentifierC 'uri
-						  "http://psi.egovpt.org/itemIdentifiers#assoc_7"))))
-	    (is (= (length (item-identifiers assoc-7))))
-	    (is (string= (uri (first (item-identifiers assoc-7)))
-			 "http://psi.egovpt.org/itemIdentifiers#assoc_7"))
-	    (is (= (length (roles assoc-7)) 2))
-	    (is (string= (uri (first (psis (instance-of assoc-7))))
-			 "http://psi.egovpt.org/types/serviceUsesStandard"))
-	    (let ((role-1 (first (roles assoc-7)))
-		  (role-2 (second (roles assoc-7))))
-	      (is (string= (uri (first (psis (instance-of role-1))))
-			   "http://psi.egovpt.org/types/ServiceRoleType"))
-	      (is (or (string= (uri (first (psis (player role-1))))
-			       "http://psi.egovpt.org/service/Google+Maps")
-		      (string= (uri (first (psis (player role-1))))
-			       "http://maps.google.com")))
-	      (is (string= (uri (first (psis (instance-of role-2))))
-			   "http://psi.egovpt.org/types/StandardRoleType"))
-	      (is (string= (uri (first (psis (player role-2))))
-			   "http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata")))))))))
+		       (is-false (item-identifiers topic))))))))))
+		      
 
-
-(test test-json-importer-merge
+(test test-json-importer-associations
   (let
       ((dir "data_base"))
     (with-fixture initialize-destination-db (dir)
       (elephant:open-store (xml-importer:get-store-spec dir))
       (xml-importer:init-isidorus)
       (elephant:open-store (xml-importer:get-store-spec dir)) ; init-isiodurs closes the store
-      (let ((t100-1 "{\"topic\":{\"id\":\"t970\",\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/standard/Common+Lisp\"],\"instanceOfs\":[[\"http://psi.egovpt.org/types/standard\"]],\"names\":[{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_n1\",\"http://www.egovpt.org/itemIdentifiers#t100_n1a\"],\"type\":null,\"scopes\":null,\"value\":\"Common Lisp\",\"variants\":[{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_n_v1\"],\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"],[\"http://psi.egovpt.org/types/long-name\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"Common-Lisp\"}}]}],\"occurrences\":[{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_o1\"],\"type\":[\"http://psi.egovpt.org/types/links\"],\"scopes\":null,\"resourceRef\":\"http://www.common-lisp.net/\",\"resourceData\":null}]},\"topicStubs\":[{\"id\":\"t220\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t3\",\"http://www.egovpt.org/itemIdentifiers#t3\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/standard\"]},{\"id\":\"t68\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"]},{\"id\":\"t284\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t50a\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/long-name\"]},{\"id\":\"t324\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t55\",\"http://psi.egovpt.org/itemIdentifiers#t55_1\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/links\"]}],\"associations\":null,\"tmIds\":[\"http://www.isidor.us/unittests/testtm\"]}")
-	    (t100-2 "{\"topic\":{\"id\":\"t945\",\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100\",\"http://www.egovpt.org/itemIdentifiers#t100_new\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/standard/Common+Lisp\"],\"instanceOfs\":[[\"http://psi.egovpt.org/types/standard\"]],\"names\":[{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_n1\"],\"type\":null,\"scopes\":null,\"value\":\"Common Lisp\",\"variants\":[{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_n_v1\"],\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"],[\"http://psi.egovpt.org/types/long-name\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"Common-Lisp\"}},{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_n_v2\"],\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#display\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"CL\"}}]}],\"occurrences\":[{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_o2\"],\"type\":[\"http://psi.egovpt.org/types/links\"],\"scopes\":null,\"resourceRef\":\"http://www.cliki.net/\",\"resourceData\":null}]},\"topicStubs\":[{\"id\":\"t220\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t3\",\"http://www.egovpt.org/itemIdentifiers#t3\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/standard\"]},{\"id\":\"t68\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"]},{\"id\":\"t284\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t50a\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/long-name\"]},{\"id\":\"t74\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm#display\"]},{\"id\":\"t324\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t55\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/links\"]}],\"associations\":null,\"tmIds\":[\"http://www.isidor.us/unittests/testtm\"]}"))
-	(is (= (length (elephant:get-instances-by-class 'TopicC)) 13))
-	(is (= (length (elephant:get-instances-by-class 'AssociationC)) 0))
-	(is (= (length (elephant:get-instances-by-class 'TopicMapC)) 1))
-	(json-importer:json-to-elem t100-1)
-	(is (= (length (elephant:get-instances-by-class 'TopicC)) 17))
-	(is (= (length (elephant:get-instances-by-class 'AssociationC)) 1))
-	(is (= (length (elephant:get-instances-by-class 'TopicMapC)) 2))
-	(let ((core-tm
-	       (loop for tm in (elephant:get-instances-by-class 'TopicMapC)
-		  when (string= (uri (first (item-identifiers tm)))
-				"http://www.topicmaps.org/xtm/1.0/core.xtm")
-		  return tm))	      
-	      (test-tm
-	       (loop for tm in (elephant:get-instances-by-class 'TopicMapC)
-		  when (string= (uri (first (item-identifiers tm)))
-				"http://www.isidor.us/unittests/testtm")
-		  return tm)))
-	  (is-true (and core-tm test-tm)))
-	(json-importer:json-to-elem t100-2)
-	(is (= (length (elephant:get-instances-by-class 'TopicC)) 17))
-	(is (= (length (elephant:get-instances-by-class 'AssociationC)) 1))
-	(is (= (length (elephant:get-instances-by-class 'TopicMapC)) 2))
-	(let ((core-tm
-	       (loop for tm in (elephant:get-instances-by-class 'TopicMapC)
-		  when (string= (uri (first (item-identifiers tm)))
-				"http://www.topicmaps.org/xtm/1.0/core.xtm")
-		  return tm))	      
-	      (test-tm
-	       (loop for tm in (elephant:get-instances-by-class 'TopicMapC)
-		  when (string= (uri (first (item-identifiers tm)))
-				"http://www.isidor.us/unittests/testtm")
-		  return tm)))
-	  (is-true (and core-tm test-tm)))
-	(let ((topics (elephant:get-instances-by-class 'TopicC)))
-	  (loop for topic in topics
-	     do (let ((psi (uri (first (psis topic)))))
-		  (cond
-		    ((string= psi "http://psi.egovpt.org/types/standard") ;t3
-		     (is (= (length (in-topicmaps topic)) 1))
-		     (is (string= (uri (first (item-identifiers (first (in-topicmaps topic)))))
-				  "http://www.isidor.us/unittests/testtm"))
-		     (is-false (names topic))
-		     (is-false (occurrences topic))
-		     (is-false (locators topic))
-		     (is (= (length (psis topic)) 1))
-		     (is (= (length (item-identifiers topic)) 2))
-		     (is (or (string= (uri (first (item-identifiers topic)))
-				      "http://www.egovpt.org/itemIdentifiers#t3")
-			     (string= (uri (second (item-identifiers topic)))
-				      "http://www.egovpt.org/itemIdentifiers#t3")))
-		     (is (or (string= (uri (first (item-identifiers topic)))
-				      "http://psi.egovpt.org/itemIdentifiers#t3")
-			     (string= (uri (second (item-identifiers topic)))
-				      "http://psi.egovpt.org/itemIdentifiers#t3"))))
-		    ((string= psi "http://psi.egovpt.org/types/long-name") ;t50a
-		     (is (= (length (in-topicmaps topic)) 1))
-		     (is (string= (uri (first (item-identifiers (first (in-topicmaps topic)))))
-				  "http://www.isidor.us/unittests/testtm"))
-		     (is-false (names topic))
-		     (is-false (occurrences topic))
-		     (is-false (locators topic))
-		     (is (= (length (psis topic)) 1))
-		     (is (= (length (item-identifiers topic)) 1))
-		     (is (string= (uri (first (item-identifiers topic)))
-				  "http://psi.egovpt.org/itemIdentifiers#t50a")))
-		    ((string= psi "http://psi.egovpt.org/types/links") ;t50
-		     (is (= (length (in-topicmaps topic)) 1))
-		     (is (string= (uri (first (item-identifiers (first (in-topicmaps topic)))))
-				  "http://www.isidor.us/unittests/testtm"))
-		     (is-false (names topic))
-		     (is-false (occurrences topic))
-		     (is-false (locators topic))
-		     (is (= (length (psis topic)) 1))
-		     (is (= (length (item-identifiers topic)) 2))
-		     (is (or (string= (uri (first (item-identifiers topic)))
-				      "http://psi.egovpt.org/itemIdentifiers#t55")
-			     (string= (uri (second (item-identifiers topic)))
-				      "http://psi.egovpt.org/itemIdentifiers#t55")))
-		     (is (or (string= (uri (first (item-identifiers topic)))
-				      "http://psi.egovpt.org/itemIdentifiers#t55_1")
-			     (string= (uri (second (item-identifiers topic)))
-				      "http://psi.egovpt.org/itemIdentifiers#t55_1"))))
-		    ((string= psi "http://psi.egovpt.org/standard/Common+Lisp") ;t100
-		     (is (= (length (in-topicmaps topic)) 1))
-		     (is (string= (uri (first (item-identifiers (first (in-topicmaps topic)))))
-				  "http://www.isidor.us/unittests/testtm"))
-		     (is (= (length (psis topic)) 1))
-		     (is (= (length (item-identifiers topic)) 2))
-		     (is (or (string= (uri (first (item-identifiers topic)))
-				      "http://www.egovpt.org/itemIdentifiers#t100")
-			     (string= (uri (second (item-identifiers topic)))
-				      "http://www.egovpt.org/itemIdentifiers#t100")))
-		     (is (or (string= (uri (first (item-identifiers topic)))
-				      "http://www.egovpt.org/itemIdentifiers#t100_new")
-			     (string= (uri (second (item-identifiers topic)))
-				      "http://www.egovpt.org/itemIdentifiers#t100_new")))
-		     (is (= (length (names topic))))
-		     (let ((name (first (names topic))))
-		       (is (= (length (item-identifiers name)) 2))
-		       (is (or (string= (uri (first (item-identifiers name)))
-					"http://www.egovpt.org/itemIdentifiers#t100_n1")
-			       (string= (uri (second (item-identifiers name)))
-					"http://www.egovpt.org/itemIdentifiers#t100_n1")))
-		       (is (or (string= (uri (first (item-identifiers name)))
-					"http://www.egovpt.org/itemIdentifiers#t100_n1a")
-			       (string= (uri (second (item-identifiers name)))
-					"http://www.egovpt.org/itemIdentifiers#t100_n1a")))
-		       (is (string= (charvalue name)
-				    "Common Lisp"))
-		       (is (= (length (variants name)) 2))
-		       (let ((variant-1 (first (variants name)))
-			     (variant-2 (second (variants name))))
-			 (is (= (length (item-identifiers variant-1)) 1))
-			 (is (string= (uri (first (item-identifiers variant-1)))
-				      "http://www.egovpt.org/itemIdentifiers#t100_n_v1"))
-			 (is (= (length (item-identifiers variant-2)) 1))
-			 (is (string= (uri (first (item-identifiers variant-2)))
-				      "http://www.egovpt.org/itemIdentifiers#t100_n_v2"))
-			 (is (= (length (themes variant-1)) 2))
-			 (is (or (string= (uri (first (psis (first (themes variant-1)))))
-					  "http://www.topicmaps.org/xtm/1.0/core.xtm#sort")
-				 (string= (uri (first (psis (second (themes variant-1)))))
-					  "http://www.topicmaps.org/xtm/1.0/core.xtm#sort")))
-			 (is (or (string= (uri (first (psis (first (themes variant-1)))))
-					  "http://psi.egovpt.org/types/long-name")
-				 (string= (uri (first (psis (second (themes variant-1)))))
-					  "http://psi.egovpt.org/types/long-name")))
-			 (is (= (length (themes variant-2)) 1))
-			 (is (string= (uri (first (psis (first (themes variant-2)))))
-				      "http://www.topicmaps.org/xtm/1.0/core.xtm#display"))
-			 (is (string= (datatype variant-1)
-				      "http://www.w3.org/2001/XMLSchema#string"))
-			 (is (string= (charvalue variant-1)
-				      "Common-Lisp"))
-			 (is (string= (datatype variant-2)
-				      "http://www.w3.org/2001/XMLSchema#string"))
-			 (is (string= (charvalue variant-2)
-				      "CL"))))
-		     (is (= (length (occurrences topic)) 2))
-		     (let ((occ-1 (first (occurrences topic)))
-			   (occ-2 (second (occurrences topic))))
-		       (is (= (length (item-identifiers occ-1)) 1))
-		       (is (string= (uri (first (item-identifiers occ-1)))
-				    "http://www.egovpt.org/itemIdentifiers#t100_o1"))
-		       (is (= (length (item-identifiers occ-2)) 1))
-		       (is (string= (uri (first (item-identifiers occ-2)))
-				    "http://www.egovpt.org/itemIdentifiers#t100_o2"))
-		       (is (string= (uri (first (psis (instance-of occ-1))))
-				    "http://psi.egovpt.org/types/links"))
-		       (is (string= (uri (first (psis (instance-of occ-2))))
-				    "http://psi.egovpt.org/types/links"))
-		       (is (string= (datatype occ-1)
-				    "http://www.w3.org/2001/XMLSchema#anyURI"))
-		       (is (string= (charvalue occ-1)
-				    "http://www.common-lisp.net/"))
-		       (is (string= (datatype occ-2)
-				    "http://www.w3.org/2001/XMLSchema#anyURI"))
-		       (is (string= (charvalue occ-2)
-				    "http://www.cliki.net/"))))
-		    (t
-		     (if (or (string= psi "http://www.topicmaps.org/xtm/1.0/core.xtm#sort")
-			     (string= psi "http://www.topicmaps.org/xtm/1.0/core.xtm#display"))
-			 (progn
-			   (is (= (length (in-topicmaps topic)) 2))
-			   (is (or (string= (uri (first (item-identifiers (first (in-topicmaps topic)))))
-					    "http://www.topicmaps.org/xtm/1.0/core.xtm")
-				   (string= (uri (first (item-identifiers (second (in-topicmaps topic)))))
-					    "http://www.topicmaps.org/xtm/1.0/core.xtm")))
-			   (is (or (string= (uri (first (item-identifiers (first (in-topicmaps topic)))))
-					    "http://www.isidor.us/unittests/testtm")
-				   (string= (uri (first (item-identifiers (second (in-topicmaps topic)))))
-					    "http://www.isidor.us/unittests/testtm"))))
-			 (progn
-			   (is (= (length (in-topicmaps topic)) 1))
-			   (is (string= (uri (first (item-identifiers (first (in-topicmaps topic)))))
-					"http://www.topicmaps.org/xtm/1.0/core.xtm")))))))))
-	(let ((instanceOf-assoc
-	       (first (elephant:get-instances-by-class 'AssociationC))))
-	  (is (string= (uri (first (psis (instance-of instanceOf-assoc))))
-		       constants::*type-instance-psi*))
-	  (is-false (d:themes instanceOf-assoc))
-	  (is (string= (d:uri (first (d:item-identifiers (first (d:in-topicmaps instanceOf-assoc)))))
-		       "http://www.isidor.us/unittests/testtm"))
-	  (is-false (d:item-identifiers instanceOf-assoc))
-	  (let ((super-type-role
-		 (loop for role in (roles instanceOf-assoc)
-		    when (string= (uri (first (psis (instance-of role))))
-				  constants:*type-psi*)
-		    return role))
-		(sub-type-role
-		 (loop for role in (roles instanceOf-assoc)
-		    when (string= (uri (first (psis (instance-of role))))
-				  constants:*instance-psi*)
-		    return role)))
-	    (is-true (and super-type-role sub-type-role))
-	    (is (string= (uri (first (psis (player super-type-role))))
-			 "http://psi.egovpt.org/types/standard"))
-	    (is (string= (uri (first (psis (player sub-type-role))))
-			 "http://psi.egovpt.org/standard/Common+Lisp"))))))))
+      (json-importer:json-to-elem *t64*)
+      (json-importer:json-to-elem *t100-3*)
+      (let ((assoc-7
+	     (identified-construct
+	      (elephant:get-instance-by-value 'ItemidentifierC 'uri
+					      "http://psi.egovpt.org/itemIdentifiers#assoc_7"))))
+	(is (= (length (item-identifiers assoc-7))))
+	(is (string= (uri (first (item-identifiers assoc-7)))
+		     "http://psi.egovpt.org/itemIdentifiers#assoc_7"))
+	(is (= (length (roles assoc-7)) 2))
+	(is (string= (uri (first (psis (instance-of assoc-7))))
+		     "http://psi.egovpt.org/types/serviceUsesStandard"))
+	(let ((role-1 (first (roles assoc-7)))
+	      (role-2 (second (roles assoc-7))))
+	  (is (string= (uri (first (psis (instance-of role-1))))
+		       "http://psi.egovpt.org/types/ServiceRoleType"))
+	  (is (or (string= (uri (first (psis (player role-1))))
+			   "http://psi.egovpt.org/service/Google+Maps")
+		  (string= (uri (first (psis (player role-1))))
+			   "http://maps.google.com")))
+	  (is (string= (uri (first (psis (instance-of role-2))))
+		       "http://psi.egovpt.org/types/StandardRoleType"))
+	  (is (string= (uri (first (psis (player role-2))))
+		       "http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata")))))))
+
+
+(test test-json-importer-merge-1
+  (let
+      ((dir "data_base"))
+    (with-fixture initialize-destination-db (dir)
+      (elephant:open-store (xml-importer:get-store-spec dir))
+      (xml-importer:init-isidorus)
+      (elephant:open-store (xml-importer:get-store-spec dir)) ; init-isidorus closes the store
+      (is (= (length (elephant:get-instances-by-class 'TopicC)) 13))
+      (is (= (length (elephant:get-instances-by-class 'AssociationC)) 0))
+      (is (= (length (elephant:get-instances-by-class 'TopicMapC)) 1))
+      (json-importer:json-to-elem *t100-1*)
+      (is (= (length (elephant:get-instances-by-class 'TopicC)) 17))
+      (is (= (length (elephant:get-instances-by-class 'AssociationC)) 1))
+      (is (= (length (elephant:get-instances-by-class 'TopicMapC)) 2))
+      (let ((core-tm
+	     (loop for tm in (elephant:get-instances-by-class 'TopicMapC)
+		when (string= (uri (first (item-identifiers tm)))
+			      "http://www.topicmaps.org/xtm/1.0/core.xtm")
+		return tm))	      
+	    (test-tm
+	     (loop for tm in (elephant:get-instances-by-class 'TopicMapC)
+		when (string= (uri (first (item-identifiers tm)))
+			      "http://www.isidor.us/unittests/testtm")
+		return tm)))
+	(is-true (and core-tm test-tm)))
+      (json-importer:json-to-elem *t100-2*)
+      (is (= (length (elephant:get-instances-by-class 'TopicC)) 17))
+      (is (= (length (elephant:get-instances-by-class 'AssociationC)) 1))
+      (is (= (length (elephant:get-instances-by-class 'TopicMapC)) 2))
+      (let ((core-tm
+	     (loop for tm in (elephant:get-instances-by-class 'TopicMapC)
+		when (string= (uri (first (item-identifiers tm)))
+			      "http://www.topicmaps.org/xtm/1.0/core.xtm")
+		return tm))	      
+	    (test-tm
+	     (loop for tm in (elephant:get-instances-by-class 'TopicMapC)
+		when (string= (uri (first (item-identifiers tm)))
+			      "http://www.isidor.us/unittests/testtm")
+		return tm)))
+	(is-true (and core-tm test-tm)))
+      (let ((topics (elephant:get-instances-by-class 'TopicC)))
+	(loop for topic in topics
+	   do (let ((psi (uri (first (psis topic)))))
+		(cond
+		  ((string= psi "http://psi.egovpt.org/types/standard") ;t3
+		   (is (= (length (in-topicmaps topic)) 1))
+		   (is (string= (uri (first (item-identifiers (first (in-topicmaps topic)))))
+				"http://www.isidor.us/unittests/testtm"))
+		   (is-false (names topic))
+		   (is-false (occurrences topic))
+		   (is-false (locators topic))
+		   (is (= (length (psis topic)) 1))
+		   (is (= (length (item-identifiers topic)) 2))
+		   (is (or (string= (uri (first (item-identifiers topic)))
+				    "http://www.egovpt.org/itemIdentifiers#t3")
+			   (string= (uri (second (item-identifiers topic)))
+				    "http://www.egovpt.org/itemIdentifiers#t3")))
+		   (is (or (string= (uri (first (item-identifiers topic)))
+				    "http://psi.egovpt.org/itemIdentifiers#t3")
+			   (string= (uri (second (item-identifiers topic)))
+				    "http://psi.egovpt.org/itemIdentifiers#t3"))))
+		  ((string= psi "http://psi.egovpt.org/types/long-name") ;t50a
+		   (is (= (length (in-topicmaps topic)) 1))
+		   (is (string= (uri (first (item-identifiers (first (in-topicmaps topic)))))
+				"http://www.isidor.us/unittests/testtm"))
+		   (is-false (names topic))
+		   (is-false (occurrences topic))
+		   (is-false (locators topic))
+		   (is (= (length (psis topic)) 1))
+		   (is (= (length (item-identifiers topic)) 1))
+		   (is (string= (uri (first (item-identifiers topic)))
+				"http://psi.egovpt.org/itemIdentifiers#t50a")))
+		  ((string= psi "http://psi.egovpt.org/types/links") ;t50
+		   (is (= (length (in-topicmaps topic)) 1))
+		   (is (string= (uri (first (item-identifiers (first (in-topicmaps topic)))))
+				"http://www.isidor.us/unittests/testtm"))
+		   (is-false (names topic))
+		   (is-false (occurrences topic))
+		   (is-false (locators topic))
+		   (is (= (length (psis topic)) 1))
+		   (is (= (length (item-identifiers topic)) 2))
+		   (is (or (string= (uri (first (item-identifiers topic)))
+				    "http://psi.egovpt.org/itemIdentifiers#t55")
+			   (string= (uri (second (item-identifiers topic)))
+				    "http://psi.egovpt.org/itemIdentifiers#t55")))
+		   (is (or (string= (uri (first (item-identifiers topic)))
+				    "http://psi.egovpt.org/itemIdentifiers#t55_1")
+			   (string= (uri (second (item-identifiers topic)))
+				    "http://psi.egovpt.org/itemIdentifiers#t55_1")))))))))))
+
+
+(test test-json-importer-merge-2
+  (let
+      ((dir "data_base"))
+    (with-fixture initialize-destination-db (dir)
+      (elephant:open-store (xml-importer:get-store-spec dir))
+      (xml-importer:init-isidorus)
+      (elephant:open-store (xml-importer:get-store-spec dir)) ; init-isidorus closes the store
+      (json-importer:json-to-elem *t100-1*)
+      (let ((core-tm
+	     (loop for tm in (elephant:get-instances-by-class 'TopicMapC)
+		when (string= (uri (first (item-identifiers tm)))
+			      "http://www.topicmaps.org/xtm/1.0/core.xtm")
+		return tm))	      
+	    (test-tm
+	     (loop for tm in (elephant:get-instances-by-class 'TopicMapC)
+		when (string= (uri (first (item-identifiers tm)))
+			      "http://www.isidor.us/unittests/testtm")
+		return tm)))
+	(is-true (and core-tm test-tm)))
+      (json-importer:json-to-elem *t100-2*)
+      (let ((topics (elephant:get-instances-by-class 'TopicC)))
+	(loop for topic in topics
+	   do (let ((psi (uri (first (psis topic)))))
+		(cond
+		  ((string= psi "http://psi.egovpt.org/types/standard") t) ;was already checked
+		  ((string= psi "http://psi.egovpt.org/types/long-name") t) ;was already checked
+		  ((string= psi "http://psi.egovpt.org/types/links") t) ;was already checked
+		  ((string= psi "http://psi.egovpt.org/standard/Common+Lisp") ;t100
+		   (is (= (length (in-topicmaps topic)) 1))
+		   (is (string= (uri (first (item-identifiers (first (in-topicmaps topic)))))
+				"http://www.isidor.us/unittests/testtm"))
+		   (is (= (length (psis topic)) 1))
+		   (is (= (length (item-identifiers topic)) 2))
+		   (is (or (string= (uri (first (item-identifiers topic)))
+				    "http://www.egovpt.org/itemIdentifiers#t100")
+			   (string= (uri (second (item-identifiers topic)))
+				    "http://www.egovpt.org/itemIdentifiers#t100")))
+		   (is (or (string= (uri (first (item-identifiers topic)))
+				    "http://www.egovpt.org/itemIdentifiers#t100_new")
+			   (string= (uri (second (item-identifiers topic)))
+				    "http://www.egovpt.org/itemIdentifiers#t100_new")))
+		   (is (= (length (names topic))))
+		   (let ((name (first (names topic))))
+		     (is (= (length (item-identifiers name)) 2))
+		     (is (or (string= (uri (first (item-identifiers name)))
+				      "http://www.egovpt.org/itemIdentifiers#t100_n1")
+			     (string= (uri (second (item-identifiers name)))
+				      "http://www.egovpt.org/itemIdentifiers#t100_n1")))
+		     (is (or (string= (uri (first (item-identifiers name)))
+				      "http://www.egovpt.org/itemIdentifiers#t100_n1a")
+			     (string= (uri (second (item-identifiers name)))
+				      "http://www.egovpt.org/itemIdentifiers#t100_n1a")))
+		     (is (string= (charvalue name)
+				  "Common Lisp"))
+		     (is (= (length (variants name)) 2))
+		     (let ((variant-1 (first (variants name)))
+			   (variant-2 (second (variants name))))
+		       (is (= (length (item-identifiers variant-1)) 1))
+		       (is (string= (uri (first (item-identifiers variant-1)))
+				    "http://www.egovpt.org/itemIdentifiers#t100_n_v1"))
+		       (is (= (length (item-identifiers variant-2)) 1))
+		       (is (string= (uri (first (item-identifiers variant-2)))
+				    "http://www.egovpt.org/itemIdentifiers#t100_n_v2"))
+		       (is (= (length (themes variant-1)) 2))
+		       (is (or (string= (uri (first (psis (first (themes variant-1)))))
+					"http://www.topicmaps.org/xtm/1.0/core.xtm#sort")
+			       (string= (uri (first (psis (second (themes variant-1)))))
+					"http://www.topicmaps.org/xtm/1.0/core.xtm#sort")))
+		       (is (or (string= (uri (first (psis (first (themes variant-1)))))
+					"http://psi.egovpt.org/types/long-name")
+			       (string= (uri (first (psis (second (themes variant-1)))))
+					"http://psi.egovpt.org/types/long-name")))
+		       (is (= (length (themes variant-2)) 1))
+		       (is (string= (uri (first (psis (first (themes variant-2)))))
+				    "http://www.topicmaps.org/xtm/1.0/core.xtm#display"))
+		       (is (string= (datatype variant-1)
+				    "http://www.w3.org/2001/XMLSchema#string"))
+		       (is (string= (charvalue variant-1)
+				    "Common-Lisp"))
+		       (is (string= (datatype variant-2)
+				    "http://www.w3.org/2001/XMLSchema#string"))
+		       (is (string= (charvalue variant-2)
+				    "CL"))))
+		   (is (= (length (occurrences topic)) 2))
+		   (let ((occ-1 (first (occurrences topic)))
+			 (occ-2 (second (occurrences topic))))
+		     (is (= (length (item-identifiers occ-1)) 1))
+		     (is (string= (uri (first (item-identifiers occ-1)))
+				  "http://www.egovpt.org/itemIdentifiers#t100_o1"))
+		     (is (= (length (item-identifiers occ-2)) 1))
+		     (is (string= (uri (first (item-identifiers occ-2)))
+				  "http://www.egovpt.org/itemIdentifiers#t100_o2"))
+		     (is (string= (uri (first (psis (instance-of occ-1))))
+				  "http://psi.egovpt.org/types/links"))
+		     (is (string= (uri (first (psis (instance-of occ-2))))
+				  "http://psi.egovpt.org/types/links"))
+		     (is (string= (datatype occ-1)
+				  "http://www.w3.org/2001/XMLSchema#anyURI"))
+		     (is (string= (charvalue occ-1)
+				  "http://www.common-lisp.net/"))
+		     (is (string= (datatype occ-2)
+				  "http://www.w3.org/2001/XMLSchema#anyURI"))
+		     (is (string= (charvalue occ-2)
+				  "http://www.cliki.net/"))))
+		  (t
+		   (if (or (string= psi "http://www.topicmaps.org/xtm/1.0/core.xtm#sort")
+			   (string= psi "http://www.topicmaps.org/xtm/1.0/core.xtm#display"))
+		       (progn
+			 (is (= (length (in-topicmaps topic)) 2))
+			 (is (or (string= (uri (first (item-identifiers (first (in-topicmaps topic)))))
+					  "http://www.topicmaps.org/xtm/1.0/core.xtm")
+				 (string= (uri (first (item-identifiers (second (in-topicmaps topic)))))
+					  "http://www.topicmaps.org/xtm/1.0/core.xtm")))
+			 (is (or (string= (uri (first (item-identifiers (first (in-topicmaps topic)))))
+					  "http://www.isidor.us/unittests/testtm")
+				 (string= (uri (first (item-identifiers (second (in-topicmaps topic)))))
+					  "http://www.isidor.us/unittests/testtm"))))
+		       (progn
+			 (is (= (length (in-topicmaps topic)) 1))
+			 (is (string= (uri (first (item-identifiers (first (in-topicmaps topic)))))
+				      "http://www.topicmaps.org/xtm/1.0/core.xtm"))))))))))))
+
+
+(test test-json-importer-merge-3
+  (let
+      ((dir "data_base"))
+    (with-fixture initialize-destination-db (dir)
+      (elephant:open-store (xml-importer:get-store-spec dir))
+      (xml-importer:init-isidorus)
+      (elephant:open-store (xml-importer:get-store-spec dir)) ; init-isidorus closes the store
+      (json-importer:json-to-elem *t100-1*)
+      (let ((core-tm
+	     (loop for tm in (elephant:get-instances-by-class 'TopicMapC)
+		when (string= (uri (first (item-identifiers tm)))
+			      "http://www.topicmaps.org/xtm/1.0/core.xtm")
+		return tm))	      
+	    (test-tm
+	     (loop for tm in (elephant:get-instances-by-class 'TopicMapC)
+		when (string= (uri (first (item-identifiers tm)))
+			      "http://www.isidor.us/unittests/testtm")
+		return tm)))
+	(is-true (and core-tm test-tm)))
+      (json-importer:json-to-elem *t100-2*)
+      (let ((instanceOf-assoc
+	     (first (elephant:get-instances-by-class 'AssociationC))))
+	(is (string= (uri (first (psis (instance-of instanceOf-assoc))))
+		     constants::*type-instance-psi*))
+	(is-false (d:themes instanceOf-assoc))
+	(is (string= (d:uri (first (d:item-identifiers (first (d:in-topicmaps instanceOf-assoc)))))
+		     "http://www.isidor.us/unittests/testtm"))
+	(is-false (d:item-identifiers instanceOf-assoc))
+	(let ((super-type-role
+	       (loop for role in (roles instanceOf-assoc)
+		  when (string= (uri (first (psis (instance-of role))))
+				constants:*type-psi*)
+		  return role))
+	      (sub-type-role
+	       (loop for role in (roles instanceOf-assoc)
+		  when (string= (uri (first (psis (instance-of role))))
+				constants:*instance-psi*)
+		  return role)))
+	  (is-true (and super-type-role sub-type-role))
+	  (is (string= (uri (first (psis (player super-type-role))))
+		       "http://psi.egovpt.org/types/standard"))
+	  (is (string= (uri (first (psis (player sub-type-role))))
+		       "http://psi.egovpt.org/standard/Common+Lisp")))))))
 
 
 (test test-get-all-topic-psis
@@ -1054,10 +1264,22 @@
 
 (defun run-json-tests()
   (tear-down-test-db)
-  ;(run! 'json-tests))
-  (it.bese.fiveam:run! 'test-get-fragment-values-from-json-list)
-  ;(it.bese.fiveam:run! 'test-json-importer) ;currently this unittest causes some problems
-  (it.bese.fiveam:run! 'test-json-importer-merge)
+  (it.bese.fiveam:run! 'test-get-fragment-values-from-json-list-general)
+  (it.bese.fiveam:run! 'test-get-fragment-values-from-json-list-names)
+  (it.bese.fiveam:run! 'test-get-fragment-values-from-json-list-occurrences)
+  (it.bese.fiveam:run! 'test-get-fragment-values-from-json-list-topicStubs)
+  (it.bese.fiveam:run! 'test-get-fragment-values-from-json-list-associations)
+  (it.bese.fiveam:run! 'test-json-importer-general-1)
+  (it.bese.fiveam:run! 'test-json-importer-general-2)
+  (it.bese.fiveam:run! 'test-json-importer-general-3)
+  (it.bese.fiveam:run! 'test-json-importer-topics-1)
+  (it.bese.fiveam:run! 'test-json-importer-topics-2)
+  (it.bese.fiveam:run! 'test-json-importer-topics-3)
+  (it.bese.fiveam:run! 'test-json-importer-topics-4)
+  (it.bese.fiveam:run! 'test-json-importer-associations)
+  (it.bese.fiveam:run! 'test-json-importer-merge-1)
+  (it.bese.fiveam:run! 'test-json-importer-merge-2)
+  (it.bese.fiveam:run! 'test-json-importer-merge-3)
   (it.bese.fiveam:run! 'test-to-json-string-associations)
   (it.bese.fiveam:run! 'test-to-json-string-fragments)
   (it.bese.fiveam:run! 'test-to-json-string-topics)



From lgiessmann at common-lisp.net  Mon Aug 31 15:30:18 2009
From: lgiessmann at common-lisp.net (Lukas Giessmann)
Date: Mon, 31 Aug 2009 11:30:18 -0400
Subject: [isidorus-cvs] r125 - in trunk/src: . unit_tests xml/rdf
Message-ID: <E1Mi8pm-0000WI-4C@common-lisp.net>

Author: lgiessmann
Date: Mon Aug 31 11:30:16 2009
New Revision: 125

Log:
rdf-importer: added some helper functions to be able to recognize constructs that were imported by isidorus, e.g. isidorus:name, etc.

Modified:
   trunk/src/constants.lisp
   trunk/src/unit_tests/rdf_importer_test.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 11:30:16 2009
@@ -39,7 +39,19 @@
 	   :*rdf2tm-object*
 	   :*rdf2tm-subject*
 	   :*rdf2tm-scope-prefix*
-	   :*tm2rdf-ns*))
+	   :*tm2rdf-ns*
+	   :*tm2rdf-topic-type-uri*
+	   :*tm2rdf-name-type-uri*
+	   :*tm2rdf-name-property*
+	   :*tm2rdf-variant-type-uri*
+	   :*tm2rdf-variant-property*
+	   :*tm2rdf-occurrence-type-uri*
+	   :*tm2rdf-occurrence-property*
+	   :*tm2rdf-role-type-uri*
+	   :*tm2rdf-role-property*
+	   :*tm2rdf-association-type-uri*
+	   :*tm2rdf-associaiton-property*))
+	   
 
 (in-package :constants)
 (defparameter *xtm2.0-ns* "http://www.topicmaps.org/xtm/")
@@ -80,24 +92,46 @@
 
 (defparameter *rdf2tm-ns* "http://isidorus/rdf2tm_mapping/")
 
-(defparameter *rdf-statement* "http://www.w3.org/1999/02/22-rdf-syntax-ns#Statement")
+(defparameter *rdf-statement* (concatenate 'string *rdf-ns* "Statement"))
 
-(defparameter *rdf-object* "http://www.w3.org/1999/02/22-rdf-syntax-ns#object")
+(defparameter *rdf-object* (concatenate 'string *rdf-ns* "object"))
 
-(defparameter *rdf-subject* "http://www.w3.org/1999/02/22-rdf-syntax-ns#subject")
+(defparameter *rdf-subject* (concatenate 'string *rdf-ns* "subject"))
 
-(defparameter *rdf-predicate* "http://www.w3.org/1999/02/22-rdf-syntax-ns#predicate")
+(defparameter *rdf-predicate* (concatenate 'string *rdf-ns* "predicate"))
 
-(defparameter *rdf-nil* "http://www.w3.org/1999/02/22-rdf-syntax-ns#nil")
+(defparameter *rdf-nil* (concatenate 'string *rdf-ns* "nil"))
 
-(defparameter *rdf-first* "http://www.w3.org/1999/02/22-rdf-syntax-ns#first")
+(defparameter *rdf-first* (concatenate 'string *rdf-ns* "first"))
 
-(defparameter *rdf-rest* "http://www.w3.org/1999/02/22-rdf-syntax-ns#rest")
+(defparameter *rdf-rest* (concatenate 'string *rdf-ns* "rest"))
 
-(defparameter *rdf2tm-object* "http://isidorus/rdf2tm_mapping/object")
+(defparameter *rdf2tm-object* (concatenate 'string *rdf2tm-ns* "object"))
 
-(defparameter *rdf2tm-subject* "http://isidorus/rdf2tm_mapping/subject")
+(defparameter *rdf2tm-subject* (concatenate 'string *rdf2tm-ns* "subject"))
 
-(defparameter *rdf2tm-scope-prefix* "http://isidorus/rdf2tm_mapping/scope/")
+(defparameter *rdf2tm-scope-prefix* (concatenate 'string *rdf2tm-ns* "scope/"))
 
-(defparameter *tm2rdf-ns* "http://isidorus/tm2rdf_mapping/")
\ No newline at end of file
+(defparameter *tm2rdf-ns* "http://isidorus/tm2rdf_mapping/")
+
+(defparameter *tm2rdf-topic-type-uri* (concatenate 'string *tm2rdf-ns* "Topic"))
+
+(defparameter *tm2rdf-name-type-uri* (concatenate 'string *tm2rdf-ns* "Name"))
+
+(defparameter *tm2rdf-name-property* (concatenate 'string *tm2rdf-ns* "name"))
+
+(defparameter *tm2rdf-variant-type-uri* (concatenate 'string *tm2rdf-ns* "Variant"))
+
+(defparameter *tm2rdf-variant-property* (concatenate 'string *tm2rdf-ns* "variant"))
+
+(defparameter *tm2rdf-occurrence-type-uri* (concatenate 'string *tm2rdf-ns* "Occurrence"))
+
+(defparameter *tm2rdf-occurrence-property* (concatenate 'string *tm2rdf-ns* "occurrence"))
+
+(defparameter *tm2rdf-role-type-uri* (concatenate 'string *tm2rdf-ns* "Role"))
+
+(defparameter *tm2rdf-role-property* (concatenate 'string *tm2rdf-ns* "role"))
+
+(defparameter *tm2rdf-association-type-uri* (concatenate 'string *tm2rdf-ns* "Association"))
+
+(defparameter *tm2rdf-association-property* (concatenate 'string *tm2rdf-ns* "association"))

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 31 11:30:16 2009
@@ -18,6 +18,7 @@
                 *rdf-ns*
 		*rdfs-ns*
 		*rdf2tm-ns*
+		*tm2rdf-ns*
 		*xml-ns*
 		*xml-string*
 		*instance-psi*
@@ -32,7 +33,13 @@
 		*rdf-subject*
 		*rdf-object*
 		*rdf-predicate*
-		*rdf-statement*)
+		*rdf-statement*
+		*tm2rdf-topic-type-uri*
+		*tm2rdf-name-type-uri*
+		*tm2rdf-variant-type-uri*
+		*tm2rdf-occurrence-type-uri*
+		*tm2rdf-role-type-uri*
+		*tm2rdf-association-type-uri*)
   (:import-from :xml-tools
                 xpath-child-elems-by-qname
 		xpath-single-child-elem-by-qname
@@ -59,7 +66,10 @@
 	   :test-poems-rdf-topics
 	   :test-empty-collection
 	   :test-collection
-	   :test-xml-base))
+	   :test-xml-base
+	   :test-get-type-psis
+	   :test-get-all-type-psis
+	   :test-isidorus-type-p))
 
 (declaim (optimize (debug 3) (speed 0) (safety 3) (space 0) (compilation-speed 0)))
 
@@ -3054,7 +3064,200 @@
 		       "http://base-3/test")))))))
 
 
+(test test-get-type-psis
+  "Tests the function get-type-psis."
+  (let ((tm-id "http://test-tm/")
+	(doc-1
+	 (concatenate 'string "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" "
+		      "xmlns:sw=\"http://test/arcs/\">"
+		      " <sw:Node rdf:about=\"http://sw/node\""
+		      "          rdf:type=\"http://sw/Node-1\">"
+		      "  <sw:type rdf:resource=\"anyResource\"/>"
+		      "  <rdf:type rdf:resource=\"Node-2\"/>"
+		      "  <rdf:type rdf:resource=\"http://sw/Node-3\"/>"
+		      "  <rdf:type rdf:nodeID=\"anyType\"/>"
+		      " </sw:Node>"
+
+		      " <rdf:Description rdf:about=\"http://sw/emtpy\"/>"
+		      "</rdf:RDF>")))
+    (let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder))))
+      (let ((rdf-node (elt (dom:child-nodes dom-1) 0)))
+	(is (= (length (rdf-importer::child-nodes-or-text rdf-node)) 2))
+	(let ((resource-1 
+	       (elt (rdf-importer::child-nodes-or-text rdf-node) 0))
+	      (resource-2 
+	       (elt (rdf-importer::child-nodes-or-text rdf-node) 1))
+	      (types (list "http://test/arcs/Node" "http://sw/Node-1"
+			   "http://xml-base/Node-2" "http://sw/Node-3"))
+	      (types-2 (list "http://test/arcs/Node" "http://sw/Node-1"
+			     (concatenate 'string tm-id "Node-2")
+			     "http://sw/Node-3")))
+	  (is-true resource-1)
+	  (is-true resource-2)
+	  (is (= (length
+		  (intersection
+		   types
+		   (rdf-importer::get-type-psis
+		    resource-1 tm-id
+		    :parent-xml-base "http://xml-base/")
+		   :test #'string=))
+		 (length types)))
+	  (is (= (length
+		  (intersection
+		   types-2
+		   (rdf-importer::get-type-psis resource-1 tm-id)
+		   :test #'string=))
+		 (length types-2)))
+	  (is-false (rdf-importer::get-type-psis
+		     resource-2 tm-id
+		     :parent-xml-base "http://xml-base/")))))))
+
+
+(test test-get-all-type-psis
+  "Tests the functions get-all-type-psis, get-type-psis-across-dom and
+   get-type-psis."
+  (let ((tm-id "http://test-tm/")
+	(doc-1
+	 (concatenate 'string "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" "
+		      "xmlns:sw=\"http://test/arcs/\">"
+		      " <rdf:Description rdf:nodeID=\"anyNode\">"
+		      "  <rdf:type rdf:resource=\"http://type-1\"/>"
+		      "  <sw:arc>"
+		      "   <rdf:Description rdf:nodeID=\"anyNode\" "
+		      "                   rdf:type=\"http://type-2\"/>"
+		      "  </sw:arc>"
+		      " </rdf:Description>"
+
+		      " <rdf:Description rdf:nodeID=\"anotherNode\">"
+		      "  <rdf:type rdf:resource=\"http://type-3\"/>"
+		      " </rdf:Description>"
+
+		      " <sw:NodeType rdf:nodeID=\"anyNode\"/>"
+
+		      " <rdf:Description rdf:nodeID=\"anyNode\" "
+		      "                  rdf:datatype=\"anyDatatype\">"
+		      "  <rdf:type rdf:resource=\"http://type-7\"/>"
+		      " </rdf:Description>"
+
+		      " <rdf:Description rdf:about=\"http://a-node\">"
+		      "  <sw:arc>"
+		      "   <rdf:Description rdf:about=\"http://b-node\">"
+		      "   <rdf:type rdf:resource=\"http://type-5\"/>"
+		      "    <rdf:arc>"
+		      "     <rdf:Description rdf:nodeID=\"anyNode\">"
+		      "      <rdf:type rdf:resource=\"http://type-5\"/>"
+		      "      <rdf:type rdf:resource=\"http://type-6\"/>"
+		      "     </rdf:Description>"
+		      "    </rdf:arc>"
+		      "   </rdf:Description>"
+		      "  </sw:arc>"
+		      " </rdf:Description>"
+		      "</rdf:RDF>")))
+    (let ((root (elt (dom:child-nodes (cxml:parse doc-1
+						  (cxml-dom:make-dom-builder)))
+		     0)))
+      (is (= (length (rdf-importer::child-nodes-or-text root)) 5))
+      (let ((any-node-1 (elt (rdf-importer::child-nodes-or-text root) 0))
+	    (another-node (elt (rdf-importer::child-nodes-or-text root) 1))
+	    (fn-types (list "http://type-1" "http://type-2"
+			    "http://test/arcs/NodeType" "http://type-5"
+			    "http://type-6"))
+	    (any-node-4 (elt (rdf-importer::child-nodes-or-text root) 3)))
+	(let ((types-1 (rdf-importer::get-all-type-psis any-node-1 tm-id))
+	      (types-4 (rdf-importer::get-all-type-psis any-node-4 tm-id))
+	      (types-another-node (rdf-importer::get-all-type-psis
+				   another-node tm-id)))
+	  (is (= (length (intersection fn-types types-1 :test #'string=))
+		 (length fn-types)))
+	  (is (= (length types-another-node) 1))
+	  (is (string= "http://type-3"
+		       (first types-another-node)))
+	  (is (= (length (intersection fn-types types-4 :test #'string=))
+		 (length fn-types))))))))
+
+
+(test test-isidorus-type-p
+  "Tests the function isidorus-type-p."
+    (let ((tm-id "http://test-tm/")
+	(doc-1
+	 (concatenate 'string "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" "
+		      "xmlns:sw=\"http://test/arcs/\" "
+		      "xmlns:isi=\"" *tm2rdf-ns* "\">"
+		      " <isi:Topic rdf:about=\"http://node-1\">"
+		      "  <isi:name>"
+		      "   <rdf:Description rdf:nodeID=\"name-id\"/>"
+		      "  </isi:name>"
+		      "  <isi:occurrence rdf:nodeID=\"occurrence-id\"/>"
+		      "  <isi:occurrence>"
+		      "   <rdf:Description>"
+		      "    <rdf:type rdf:resource=\""
+		                          *tm2rdf-occurrence-type-uri* "\"/>"
+		      "   </rdf:Description>"
+		      "  </isi:occurrence>"
+		      " </isi:Topic>"
+
+		      " <rdf:Description rdf:nodeID=\"name-id\">"
+		      "  <rdf:type rdf:resource=\"" *tm2rdf-name-type-uri*"\"/>"
+		      "  <isi:variant>"
+		      "   <isi:Variant rdf:nodeID=\"variant-id\"/>"
+		      "  </isi:variant>"
+		      " </rdf:Description>"
+
+		      " <isi:Occurrence rdf:nodeID=\"occurrence-id\"/>"
+
+		      " <rdf:Description rdf:nodeID=\"association-id\">"
+		      "  <rdf:type rdf:resource=\""
+		                      *tm2rdf-association-type-uri* "\"/>"
+		      "  <isi:role>"
+		      "   <isi:Role rdf:nodeID=\"role-id\"/>"
+                      "  </isi:role>"
+		      " </rdf:Description>"
+		      "</rdf:RDF>")))
+    (let ((root (elt (dom:child-nodes (cxml:parse doc-1
+						  (cxml-dom:make-dom-builder)))
+		     0)))
+      (is (= (length (rdf-importer::child-nodes-or-text root)) 4))
+      (let ((topic-node (elt (rdf-importer::child-nodes-or-text root) 0))
+	    (association-node (elt (rdf-importer::child-nodes-or-text root) 3)))
+	(let ((topic-name (elt (rdf-importer::child-nodes-or-text topic-node) 
+			       0))
+	      (topic-occurrence-1 (elt (rdf-importer::child-nodes-or-text
+					topic-node)
+				       1))
+	      (topic-occurrence-2 (elt (rdf-importer::child-nodes-or-text
+					topic-node)
+				       2))
+	      (association-role (elt (rdf-importer::child-nodes-or-text
+				      association-node)
+				     1))
+	      (name-variant (elt (rdf-importer::child-nodes-or-text
+				  (elt (rdf-importer::child-nodes-or-text root)
+				       1))
+				 1)))
+	  (is-true (rdf-importer::isidorus-type-p topic-node tm-id 
+						  'rdf-importer::topic))
+	  (is-true (rdf-importer::isidorus-type-p association-node tm-id
+						  'rdf-importer::association))
+	  (is-true (rdf-importer::isidorus-type-p topic-name tm-id
+						  'rdf-importer::name))
+	  (is-true (rdf-importer::isidorus-type-p name-variant tm-id
+						  'rdf-importer::variant))
+	  (is-true (rdf-importer::isidorus-type-p topic-occurrence-1 tm-id
+						  'rdf-importer::occurrence))
+	  (is-true (rdf-importer::isidorus-type-p topic-occurrence-2 tm-id
+						  'rdf-importer::occurrence))
+	  (is-true (rdf-importer::isidorus-type-p association-role tm-id
+						  'rdf-importer::role))
+	  (is-false (rdf-importer::isidorus-type-p
+		     (elt (rdf-importer::child-nodes-or-text root) 1) tm-id
+		     'rdf-importer::name))
+	  (is-false (rdf-importer::isidorus-type-p
+		     (elt (rdf-importer::child-nodes-or-text root) 2) tm-id
+		     'rdf-importer::occurrence)))))))
+
+
 (defun run-rdf-importer-tests()
+  "Runs all defined tests."
   (when elephant:*store-controller*
     (elephant:close-store))
   (it.bese.fiveam:run! 'test-get-literals-of-node)
@@ -3075,4 +3278,7 @@
   (it.bese.fiveam:run! 'test-poems-rdf-topics)
   (it.bese.fiveam:run! 'test-empty-collection)
   (it.bese.fiveam:run! 'test-collection)
-  (it.bese.fiveam:run! 'test-xml-base))
\ No newline at end of file
+  (it.bese.fiveam:run! 'test-xml-base)
+  (it.bese.fiveam:run! 'test-get-type-psis)
+  (it.bese.fiveam:run! 'test-get-all-type-psis)
+  (it.bese.fiveam:run! 'test-isidorus-type-p))
\ 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	Mon Aug 31 11:30:16 2009
@@ -96,8 +96,7 @@
   (format t ">> import-node: ~a <<~%" (dom:node-name elem)) ;TODO: remove
   (tm-id-p tm-id "import-node")
   (parse-node elem)
-  (let ((fn-xml-base (get-xml-base elem :old-base xml-base))
-	(fn-xml-lang (get-xml-lang elem :old-lang xml-lang)))
+  (let ((fn-xml-lang (get-xml-lang elem :old-lang xml-lang)))
     (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"))
@@ -108,16 +107,7 @@
 			    (get-literals-of-node-content
 			     elem tm-id xml-base fn-xml-lang)))
 	  (associations (get-associations-of-node-content elem tm-id xml-base))
-	  (types (remove-if
-		  #'null
-		  (append (list
-			   (unless (string= (get-type-of-node-name elem)
-					    (concatenate 'string *rdf-ns*
-							 "Description"))
-			     (list :topicid (get-type-of-node-name elem)
-				   :psi (get-type-of-node-name elem)
-				   :ID nil)))
-			  (get-types-of-node-content elem tm-id fn-xml-base))))
+	  (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)))
       (with-tm (start-revision document-id tm-id)

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 11:30:16 2009
@@ -31,7 +31,18 @@
 		*rdf-nil*
 		*rdf-first*
 		*rdf-rest*
-		*rdf2tm-scope-prefix*)
+		*rdf2tm-scope-prefix*
+		*tm2rdf-topic-type-uri*
+		*tm2rdf-name-type-uri*
+		*tm2rdf-name-property*
+		*tm2rdf-variant-type-uri*
+		*tm2rdf-variant-property*
+		*tm2rdf-occurrence-type-uri*
+		*tm2rdf-occurrence-property*
+		*tm2rdf-role-type-uri*
+		*tm2rdf-role-property*
+		*tm2rdf-association-type-uri*
+		*tm2rdf-association-property*)
   (:import-from :xml-constants
 		*rdf_core_psis.xtm*
 		*core_psis.xtm*)
@@ -369,8 +380,7 @@
 	     datatype))
     (when (and (or nodeID resource)
 	       (> (length content) 0))
-      ;(set-_n-name property _n-counter)))
-      (error "~awhen ~a is set no content is allowed: ~a!"
+     (error "~awhen ~a is set no content is allowed: ~a!"
 	     err-pref
 	     (cond
 	       (nodeID (concatenate 'string "rdf:nodeID (" nodeID ")"))
@@ -469,4 +479,187 @@
   "Checks the validity of the passed tm-id."
   (unless (absolute-uri-p tm-id)
     (error "From ~a(): you must provide a stable identifier (PSI-style) for this TM: ~a!"
-	   fun-name tm-id)))
\ No newline at end of file
+	   fun-name tm-id)))
+
+
+(defun get-types-of-node (elem tm-id &key (parent-xml-base nil))
+  "Returns a plist of all node's types of the form
+   (:topicid <string> :psi <string> :ID <string>)."
+  (let ((xml-base (get-xml-base elem :old-base parent-xml-base)))
+    (remove-if
+     #'null
+     (append (unless (string= (get-type-of-node-name elem)
+			      (concatenate 'string *rdf-ns*
+					   "Description"))
+	       (list 
+		(list :topicid (get-type-of-node-name elem)
+		      :psi (get-type-of-node-name elem)
+		      :ID nil)))
+	     (get-types-of-node-content elem tm-id xml-base)))))
+
+
+(defun get-type-psis (elem tm-id
+		      &key (parent-xml-base nil))
+  "Returns a list of type-uris of the passed node."
+  (let ((types (get-types-of-node elem tm-id
+				  :parent-xml-base parent-xml-base)))
+    (remove-if #'null
+	       (map 'list #'(lambda(x)
+			      (getf x :psi))
+		    types))))
+
+
+(defun get-all-type-psis-of-id (nodeID tm-id document)
+  "Returns a list of type-uris for resources identified by the given
+   nodeID by analysing the complete XML-DOM."
+  (let ((root (elt (dom:child-nodes document) 0)))
+    (remove-duplicates
+     (remove-if #'null
+		(if (and (string= (dom:namespace-uri root) *rdf-ns*)
+			 (string= (get-node-name root)"RDF"))
+		    (loop for node across (child-nodes-or-text root)
+		       append (get-all-type-psis-across-dom
+			       root tm-id :resource-id nodeID))
+		    (get-all-type-psis-across-dom
+		     root tm-id :resource-id nodeID)))
+     :test #'string=)))
+
+
+(defun get-all-type-psis (elem tm-id &key (parent-xml-base nil))
+  "Returns a list of type-uris for the element by analysing the complete
+   XML-DOM."
+  (let ((xml-base (get-xml-base elem :old-base parent-xml-base)))
+    (let ((root (elt (dom:child-nodes (dom:owner-document elem)) 0))
+	  (nodeID (get-ns-attribute elem "nodeID"))
+	  (about (get-absolute-attribute elem tm-id xml-base "about")))
+      (remove-duplicates
+       (remove-if #'null
+		  (if (or nodeID about)
+		      (if (and (string= (dom:namespace-uri root) *rdf-ns*)
+			       (string= (get-node-name root) "RDF"))
+			  (loop for node across (child-nodes-or-text root)
+			     append (get-all-type-psis-across-dom
+				     root tm-id :resource-uri about
+				     :resource-id nodeID))
+			  (get-all-type-psis-across-dom
+			   root tm-id :resource-uri about
+			   :resource-id nodeID))
+		      (get-type-psis elem tm-id :parent-xml-base parent-xml-base)))
+       :test #'string=))))
+
+
+(defun get-all-type-psis-across-dom (elem tm-id &key (parent-xml-base nil)
+				     (resource-uri nil) (resource-id nil)
+				     (types nil))
+  "Returns a list of type PSI strings collected over the complete XML-DOM
+   corresponding to the passed id's or uri."
+  (when (or resource-uri resource-id)
+    (let ((xml-base (get-xml-base elem :old-base parent-xml-base)))
+      (let ((datatype (when (get-ns-attribute elem "datatype")
+			t))
+	    (parseType (when (get-ns-attribute elem "parseType")
+			 (string= (get-ns-attribute elem "parseType")
+				  "Literal"))))
+	(if (or datatype parseType)
+	    types
+	    (let ((nodeID (get-ns-attribute elem "nodeID"))
+		  (about (get-absolute-attribute elem tm-id xml-base "about")))
+	      (let ((fn-types
+		     (append types
+			     (when (or (and about resource-uri
+					    (string= about resource-uri))
+				       (and nodeID resource-id
+					    (string= nodeID resource-id)))
+			       (get-type-psis elem tm-id
+					      :parent-xml-base xml-base))))
+		    (content (child-nodes-or-text elem :trim t)))
+		(if (or (stringp content)
+			(not content))
+		    fn-types
+		    (loop for child-node across content
+		       append (get-all-type-psis-across-dom
+			       child-node tm-id :parent-xml-base xml-base
+			       :resource-uri resource-uri
+			       :resource-id resource-id
+			       :types fn-types))))))))))
+
+
+(defun type-p (elem type-uri tm-id &key (parent-xml-base nil))
+  "Returns t if the type-uri is a type of elem."
+  (declare (string tm-id type-uri))
+  (declare (dom:element elem))
+  (tm-id-p tm-id "type-p")
+  (find type-uri (get-all-type-psis elem tm-id
+				    :parent-xml-base parent-xml-base)
+	:test #'string=))
+
+
+(defun type-of-id-p (node-id type-uri tm-id document)
+  "Returns t if type-uri is a type of the passed node-id."
+  (declare (string node-id type-uri tm-id))
+  (declare (dom:document document))
+  (tm-id-p tm-id "type-of-ndoe-id-p")
+  (find type-uri (get-all-type-psis-of-id node-id tm-id document)
+	:test #'string=))
+
+
+(defun property-name-of-node-p (elem property-name-uri)
+  "Returns t if the elements tag-name and namespace are equal
+   to the given uri."
+  (declare (dom:element elem))
+  (declare (string property-name-uri))
+  (when property-name-uri
+    (let ((uri (concatenate-uri (dom:namespace-uri elem)
+				(get-node-name elem))))
+      (string= uri property-name-uri))))
+
+
+(defun isidorus-type-p (property-elem-or-node-elem tm-id what
+			&key(parent-xml-base nil))
+  "Returns t if the node elem is of the type isidorus:<Type> and is
+   contained in a porperty isidorus:<type>."
+  (declare (dom:element property-elem-or-node-elem))
+  (declare (symbol what))
+  (tm-id-p tm-id "isidorus-type-p")
+  (let ((xml-base (get-xml-base property-elem-or-node-elem
+				:old-base parent-xml-base))
+	(type-and-property (cond
+			     ((eql what 'name)
+			      (list :type *tm2rdf-name-type-uri*
+				    :property *tm2rdf-name-property*))
+			     ((eql what 'variant)
+			      (list :type *tm2rdf-variant-type-uri*
+				    :property *tm2rdf-variant-property*))
+			     ((eql what 'occurrence)
+			      (list :type *tm2rdf-occurrence-type-uri*
+				    :property *tm2rdf-occurrence-property*))
+			     ((eql what 'role)
+			      (list :type *tm2rdf-role-type-uri*
+				    :property *tm2rdf-role-property*))
+			     ((eql what 'topic)
+			      (list :type *tm2rdf-topic-type-uri*))
+			     ((eql what 'association)
+			      (list :type 
+				    *tm2rdf-association-type-uri*)))))
+    (when type-and-property
+      (let ((type (getf type-and-property :type))
+	    (property (getf type-and-property :property))
+	    (nodeID (get-ns-attribute property-elem-or-node-elem "nodeID"))
+	    (document (dom:owner-document property-elem-or-node-elem))
+	    (elem-uri (concatenate-uri
+		       (dom:namespace-uri
+			property-elem-or-node-elem)
+		       (get-node-name property-elem-or-node-elem))))
+	(if (or (string= type *tm2rdf-topic-type-uri*)
+		(string= type *tm2rdf-association-type-uri*))
+	    (type-p property-elem-or-node-elem type tm-id
+		    :parent-xml-base parent-xml-base)
+	    (when (string= elem-uri property)
+	      (if nodeID
+		  (type-of-id-p nodeId type tm-id document)
+		  (let ((content (child-nodes-or-text  property-elem-or-node-elem
+						       :trim t)))
+		    (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



From lgiessmann at common-lisp.net  Mon Aug 31 16:20:06 2009
From: lgiessmann at common-lisp.net (Lukas Giessmann)
Date: Mon, 31 Aug 2009 12:20:06 -0400
Subject: [isidorus-cvs] r126 - in trunk/src: . xml/rdf
Message-ID: <E1Mi9by-0003g8-Mf@common-lisp.net>

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



From lgiessmann at common-lisp.net  Mon Aug 31 20:01:57 2009
From: lgiessmann at common-lisp.net (Lukas Giessmann)
Date: Mon, 31 Aug 2009 16:01:57 -0400
Subject: [isidorus-cvs] r127 - trunk/src/xml/rdf
Message-ID: <E1MiD4f-0004Eg-5W@common-lisp.net>

Author: lgiessmann
Date: Mon Aug 31 16:01:56 2009
New Revision: 127

Log:
rdf-exporter: fixed a bug with exporting association which has to be mapped as sisidorus:Association nodes

Modified:
   trunk/src/xml/rdf/exporter.lisp

Modified: trunk/src/xml/rdf/exporter.lisp
==============================================================================
--- trunk/src/xml/rdf/exporter.lisp	(original)
+++ trunk/src/xml/rdf/exporter.lisp	Mon Aug 31 16:01:56 2009
@@ -97,7 +97,7 @@
                   (d:find-item-by-revision top revision))
               (if ,tm
                   (union
-                    (d:topics ,tm) (d:associations ,tm))
+                    (d:topics ,tm) (intersection (list-tm-associations) (d:associations ,tm)))
                   (union
                    (elephant:get-instances-by-class 'd:TopicC)
                    (list-tm-associations)))))))