From lgiessmann at common-lisp.net  Mon Mar  9 18:20:13 2009
From: lgiessmann at common-lisp.net (Lukas Giessmann)
Date: Mon, 09 Mar 2009 18:20:13 +0000
Subject: [isidorus-cvs] r15 - in trunk: docs src src/json src/model
	src/rest_interface src/unit_tests
Message-ID: <E1Lgk5F-0004H8-41@common-lisp.net>

Author: lgiessmann
Date: Mon Mar  9 18:20:10 2009
New Revision: 15

Log:
added all necessary file for the json-restful-interface and some small changes, e.g. resourceRef-topics will be added to the referenced topics of a fragment-main-topic, the add-association function was changed to make sure that the association will be made by both instances, the unittest versions-test was fixed+ssh://lgiessmann at common-lisp.net/project/isidorus/svn

Added:
   trunk/docs/xtm_json.txt   (contents, props changed)
   trunk/src/json/json_importer.lisp
   trunk/src/json/json_interface.html
   trunk/src/rest_interface/set-up-json-interface.lisp
Modified:
   trunk/docs/install_isidorus.txt
   trunk/src/isidorus.asd
   trunk/src/json/json_exporter.lisp
   trunk/src/model/changes.lisp
   trunk/src/model/datamodel.lisp
   trunk/src/rest_interface/rest-interface.lisp
   trunk/src/unit_tests/json_test.lisp
   trunk/src/unit_tests/versions_test.lisp

Modified: trunk/docs/install_isidorus.txt
==============================================================================
--- trunk/docs/install_isidorus.txt	(original)
+++ trunk/docs/install_isidorus.txt	Mon Mar  9 18:20:10 2009
@@ -19,7 +19,7 @@
 darcs get http://www.common-lisp.net/project/elephant/darcs/elephant-unstable/
 
 Also install all of its dependencies as described in elephant_install.txt. In particular these are:
-
+ * (require 'asdf-install)
  * (asdf-install:install 'CL-BASE64)
  * (asdf-install:install 'uffi) 
 

Added: trunk/docs/xtm_json.txt
==============================================================================
--- (empty file)
+++ trunk/docs/xtm_json.txt	Mon Mar  9 18:20:10 2009
@@ -0,0 +1,300 @@
+resourceData:
+{
+  "datatype" : "Text",
+  "value" : "Text"
+}
+
+
+variant:
+{
+  "itemIdentities" : [ "Text" , "..." ],
+  "scopes" : [ [ "PSI-1-t1", "PSI-2-t1", "..." ], [ "PSI-1-t2", "PSI-2-t2", "..." ], [ "..." ] ],
+  "resourceRef" : "Text",
+  "resourceData" : { <resourceData> }
+}
+
+
+name:
+{
+  "itemIdentities" : [ "Text", "..." ],
+  "type" : [ "PSI-1", "PSI-2", "..." ],
+  "scopes" : [ [ "PSI-1-t1", "PSI-2-t1", "..." ], [ "PSI-1-t2", "PSI-2-t2", "..." ], [ "..." ] ],
+  "value" : "Text",
+  "variants" : [ {<variant>}, { <...> ] }
+}
+
+
+occurrence:
+{
+  "itemIdentities" : [ "Text", "..." ],
+  "type" : [ "PSI-1", "PSI-2", "..." ],
+  "scopes" : [ [ "PSI-1-t1", "PSI-2-t1", "..." ], [ "PSI-1-t2", "PSI-2-t2", "..." ], [ "..." ] ],
+  "resourceRef" : "Text",
+  "resourceData" : { <resourceData> }
+}
+
+
+topic:
+{
+  "id" : "Text",
+  "itemIdentities" : [ "Text", "..." ],
+  "subjectLocators" : [ "Text", "..." ],
+  "subjectIdentifiers" : [ "Text", "..." ],
+  "instanceOfs" : [ [ "PSI-1-t1", "PSI-2-t1", "..." ], [ "PSI-1-t2", "PSI-2-t2", "..." ], [ "..." ] ],
+  "names" : [ { <name> }, { <...> } ],
+  "occurrences" : [ { <occurrence> }, { <...> } ]
+}
+
+
+role:
+{
+  "itemIdentities" : [ "Text", "..." ],
+  "type" : [ "PSI-1", "PSI-2", "..." ],
+  "topicRef" : [ "PSI-1", "PSI-2", "..." ]
+}
+
+
+association:
+{
+  "itemIdentities" : [ "Text", "..." ],
+  "type" : [ "PSI-1", "PSI-2", "..." ],
+  "scopes" : [ [ "PSI-1-t1", "PSI-2-t1", "..." ], [ "PSI-1-t2", "PSI-2-t2", "..." ], [ "..." ] ],
+  "roles" : [ { <role> }, { <...> } ]
+}
+
+
+topicStub:
+{
+  "id" : "Text",
+  "itemIdentities" : [ "Text", "..." ],
+  "subjectLocators" : [ "Text", "..." ],
+  "subjectIdentifiers" : [ "Text", "..." ]
+}
+
+
+fragment
+{
+  "topic" : { <topic> },
+  "topicStubs" : [ { <topicStub> }, { <...> } ],
+  "associations" : [ { <association> }, { <...> } ],
+  "tm-ids" : [ "id-1", "id-2", "..." ]
+}
+// the field tm-ids should have only one tm-id in the list, because
+// there will be used only the first if the fragment is an incoming one
+// outgoing fragment have a list with more tm-ids but at least one
+
+
+
+=== example fragment with one topic, a few topicStubs and associations =========
+{
+  "topic" : {
+              "id"  :  "t403",
+              "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" : "t227",
+		     "itemIdentities" : [ "http : //psi.egovpt.org/itemIdentifiers#t3a" ],
+                     "subjectLocators" : null,
+		     "subjectIdentifiers" : [ "http : //psi.egovpt.org/types/semanticstandard" ]
+		   },
+		   {
+		     "id" : "t73",
+		     "itemIdentities" : null,
+		     "subjectLocators" : null,
+		     "subjectIdentifiers" : [ "http : //www.topicmaps.org/xtm/1.0/core.xtm#display" ]
+		   },
+		   {
+		     "id" : "t67",
+		     "itemIdentities" : null,
+		     "subjectLocators" : null,
+		     "subjectIdentifiers" : [ "http : //www.topicmaps.org/xtm/1.0/core.xtm#sort" ]
+		   },
+		   {
+		     "id" : "t291",
+		     "itemIdentities" : [ "http : //psi.egovpt.org/itemIdentifiers#t51" ],
+		     "subjectLocators" : null,
+		     "subjectIdentifiers" : [ "http : //psi.egovpt.org/types/standardHasStatus" ]
+		   },
+		   {
+		     "id" : "t307",
+		     "itemIdentities" : [ "http : //psi.egovpt.org/itemIdentifiers#t53" ],
+		     "subjectLocators" : null,
+		     "subjectIdentifiers" : [ "http : //psi.egovpt.org/types/description" ]
+		   },
+		   {
+		     "id" : "t315",
+		     "itemIdentities" : [ "http : //psi.egovpt.org/itemIdentifiers#t54" ],
+		     "subjectLocators" : null,
+		     "subjectIdentifiers" : [ "http : //psi.egovpt.org/types/standardValidFromDate" ]
+		   },
+		   {
+		     "id" : "t323",
+		     "itemIdentities" : [ "http : //psi.egovpt.org/itemIdentifiers#t55" ],
+		     "subjectLocators" : null,
+		     "subjectIdentifiers" : [ "http : //psi.egovpt.org/types/links" ]
+		   },
+		   {
+		     "id" : "t433",
+		     "itemIdentities" : null,
+		     "subjectLocators" : null,
+		     "subjectIdentifiers" : [ "http : //psi.egovpt.org/subject/GeoData" ]
+		   },
+		   {
+		     "id" : "t363",
+		     "itemIdentities" : [ "http : //psi.egovpt.org/itemIdentifiers#t60" ],
+		     "subjectLocators" : null,
+		     "subjectIdentifiers" : [ "http : //psi.egovpt.org/types/standardIsAboutSubject" ]
+		   },
+		   {
+		     "id" : "t371",
+		     "itemIdentities" : [ "http : //psi.egovpt.org/itemIdentifiers#t61" ],
+		     "subjectLocators" : null,
+		     "subjectIdentifiers" : [ "http : //psi.egovpt.org/types/SubjectRoleType" ]
+		   },
+		   {
+		     "id" : "t421",
+		     "itemIdentities" : null,
+		     "subjectLocators" : null,
+		     "subjectIdentifiers" : [ "http : //psi.egovpt.org/subject/Semantic+Description" ]
+		   },
+		   {
+		     "id" : "t395",
+		     "itemIdentities" : [ "http : //psi.egovpt.org/itemIdentifiers#t64" ],
+		     "subjectLocators" : null,
+		     "subjectIdentifiers" : [ "http : //psi.egovpt.org/types/serviceUsesStandard" ]
+		   },
+		   {
+		     "id" : "t387",
+		     "itemIdentities" : [ "http : //psi.egovpt.org/itemIdentifiers#t63" ],
+		     "subjectLocators" : null,
+		     "subjectIdentifiers" : [ "http : //psi.egovpt.org/types/ServiceRoleType" ]
+		   },
+		   {
+		     "id" : "t451",
+		     "itemIdentities" : null,
+		     "subjectLocators" : null,
+		     "subjectIdentifiers" : [ "http : //psi.egovpt.org/service/Google+Maps",
+					      "http : //maps.google.com" ]
+		   },
+		   {
+		     "id" : "t379",
+		     "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" ]
+				   }
+				  ]
+		     }
+		   ],
+  "tm-ids" : [ "test-tm"]
+}

Modified: trunk/src/isidorus.asd
==============================================================================
--- trunk/src/isidorus.asd	(original)
+++ trunk/src/isidorus.asd	Mon Mar  9 18:20:10 2009
@@ -62,6 +62,8 @@
 			:components ((:file "rest-interface")
                                      (:file "publish_feeds"
                                             :depends-on ("rest-interface"))
+				     (:file "set-up-json-interface"
+					    :depends-on ("rest-interface"))
                                      (:file "read" 
                                             :depends-on ("rest-interface")))
 		       	:depends-on ("model" 
@@ -115,8 +117,10 @@
 				     "xml"
 				     "json"))
 	       (:module "json"
-	                :components ((:file "json_exporter"))
-	                :depends-on ("model"))
+	                :components ((:file "json_exporter")
+				     (:file "json_importer")
+				     (:static-file "json_interface.html"))
+	                :depends-on ("model" "xml"))
 	       (:module "threading"
 			:components ((:file "reader-writer"))))
   :depends-on (:cxml

Modified: trunk/src/json/json_exporter.lisp
==============================================================================
--- trunk/src/json/json_exporter.lisp	(original)
+++ trunk/src/json/json_exporter.lisp	Mon Mar  9 18:20:10 2009
@@ -6,8 +6,8 @@
 
 ;; the json schema for our datamodel is in ".../docs/xtm_json.txt"
 
-(defgeneric to-json-string (instance)
-  (:documentation "converts the Topic Maps construct instance to an json string"))
+(defgeneric to-json-string (instance &key xtm-id)
+  (:documentation "converts the Topic Maps construct instance to a json string"))
 
 
 (defun identifiers-to-json-string (parent-construct &key (what 'd:psis))
@@ -20,12 +20,19 @@
       (json:encode-json-to-string items))))
 
 
-(defun resourceX-to-json-string (value datatype)
+(defun resourceX-to-json-string (value datatype &key (xtm-id d:*current-xtm*))
   "returns a resourceRef and resourceData json object"
   ;(declare (string value datatype))
   (if (string= datatype "http://www.w3.org/2001/XMLSchema#anyURI")
-      (concatenate 'string "\"resourceRef\":"
-		           (json:encode-json-to-string value)
+      (concatenate 'string "\"resourceRef\":"		   
+		   (let ((inner-value
+			  (let ((ref-topic (when (and (> (length value) 0)
+						      (eql (elt value 0) #\#))
+					     (get-item-by-id (subseq value 1) :xtm-id xtm-id))))
+			    (if ref-topic
+				(concatenate 'string "#" (topicid ref-topic))
+				value))))
+		           (json:encode-json-to-string inner-value))
 		           ",\"resourceData\":null")
       (concatenate 'string "\"resourceRef\":null,"
 		           "\"resourceData\":{\"datatype\":"
@@ -56,7 +63,7 @@
 		   "null")))
 
 
-(defmethod to-json-string ((instance VariantC))
+(defmethod to-json-string ((instance VariantC) &key (xtm-id d:*current-xtm*))
   "transforms a VariantC object to a json string"
   (let ((itemIdentity
 	 (concatenate 'string "\"itemIdentities\":"
@@ -70,11 +77,11 @@
 	       (type
 		(when (slot-boundp instance 'datatype)
 		  (datatype instance))))
-	   (resourceX-to-json-string value type))))
+	   (resourceX-to-json-string value type :xtm-id xtm-id))))
     (concatenate 'string "{" itemIdentity "," scope "," resourceX "}")))
 
 
-(defmethod to-json-string ((instance NameC))
+(defmethod to-json-string ((instance NameC) &key (xtm-id d:*current-xtm*))
   "transforms a NameC object to a json string"
   (let ((itemIdentity
 	 (concatenate 'string "\"itemIdentities\":"
@@ -93,14 +100,15 @@
 	     (concatenate 'string "\"variants\":"
 			  (let ((j-variants "["))
 			    (loop for variant in (variants instance)
-			       do (setf j-variants (concatenate 'string j-variants
-							      (json-exporter::to-json-string variant) ",")))
+			       do (setf j-variants
+					(concatenate 'string j-variants
+						     (json-exporter::to-json-string variant :xtm-id xtm-id) ",")))
 			    (concatenate 'string (subseq j-variants 0 (- (length j-variants) 1)) "]")))
 	     (concatenate 'string "\"variants\":null"))))
     (concatenate 'string "{" itemIdentity "," type "," scope "," value "," variant "}")))
 
 
-(defmethod to-json-string ((instance OccurrenceC))
+(defmethod to-json-string ((instance OccurrenceC) &key (xtm-id d:*current-xtm*))
   "transforms an OccurrenceC object to a json string"
   (let ((itemIdentity
 	 (concatenate 'string "\"itemIdentities\":"
@@ -116,11 +124,11 @@
 	       (type
 		(when (slot-boundp instance 'datatype)
 		  (datatype instance))))
-	   (resourceX-to-json-string value type))))
+	   (resourceX-to-json-string value type :xtm-id xtm-id))))
     (concatenate 'string "{" itemIdentity "," type "," scope "," resourceX "}")))
 
 
-(defmethod to-json-string ((instance TopicC))
+(defmethod to-json-string ((instance TopicC) &key (xtm-id d:*current-xtm*))
   "transforms an OccurrenceC object to a json string"
   (let ((id
 	 (concatenate 'string "\"id\":\"" (topicid instance) "\""))
@@ -140,7 +148,8 @@
 		      (if (names instance)
 			  (let ((j-names "["))
 			    (loop for item in (names instance)
-			       do (setf j-names (concatenate 'string j-names (to-json-string item) ",")))
+			       do (setf j-names
+					(concatenate 'string j-names (to-json-string item :xtm-id xtm-id) ",")))
 			    (concatenate 'string (subseq j-names 0 (- (length j-names) 1)) "]"))
 			  "null")))
 	(occurrence
@@ -148,15 +157,39 @@
 		      (if (occurrences instance)
 			  (let ((j-occurrences "["))
 			    (loop for item in (occurrences instance)
-			       do (setf j-occurrences (concatenate 'string j-occurrences (to-json-string item) ",")))
+			       do (setf j-occurrences
+					(concatenate 'string j-occurrences (to-json-string item :xtm-id xtm-id) ",")))
 			    (concatenate 'string (subseq j-occurrences 0 (- (length j-occurrences) 1)) "]"))
 			  "null"))))
     (concatenate 'string "{" id "," itemIdentity "," subjectLocator "," subjectIdentifier ","
-		         instanceOf "," name "," occurrence "}")))
+		 instanceOf "," name "," occurrence "}")))
 
 
-(defmethod to-json-string ((instance RoleC))
+(defun to-json-topicStub-string (topic)
+  "transforms the passed TopicC object to a topic stub
+   string in the json format, which contains an id,
+   all itemIdentities, all subjectLocators and all
+   subjectIdentifiers"
+  (when topic
+    (let ((id
+	   (concatenate 'string "\"id\":\"" (topicid topic) "\""))
+	  (itemIdentity
+	   (concatenate 'string "\"itemIdentities\":"
+			(identifiers-to-json-string topic :what 'item-identifiers)))
+	  (subjectLocator 
+	   (concatenate 'string "\"subjectLocators\":"
+			(identifiers-to-json-string topic :what 'locators)))
+	  (subjectIdentifier
+	   (concatenate 'string "\"subjectIdentifiers\":"
+			(identifiers-to-json-string topic :what 'psis))))
+      (declare (TopicC topic))
+      (concatenate 'string "{" id "," itemIdentity "," subjectLocator ","
+		   subjectIdentifier "}"))))
+
+
+(defmethod to-json-string ((instance RoleC) &key (xtm-id d:*current-xtm*))
   "transforms an RoleC object to a json string"
+  (declare (ignorable xtm-id))
   (let ((itemIdentity
 	 (concatenate 'string "\"itemIdentities\":"
 		      (identifiers-to-json-string instance :what 'item-identifiers)))
@@ -170,7 +203,7 @@
     (concatenate 'string "{" itemIdentity "," type "," topicRef "}")))
 
 
-(defmethod to-json-string ((instance AssociationC))
+(defmethod to-json-string ((instance AssociationC) &key (xtm-id d:*current-xtm*))
   "transforms an AssociationC object to a json string"
   (let ((itemIdentity
 	 (concatenate 'string "\"itemIdentities\":"
@@ -185,7 +218,54 @@
 		      (if (roles instance)
 			  (let ((j-roles "["))
 			    (loop for item in (roles instance)
-			       do (setf j-roles (concatenate 'string j-roles (to-json-string item) ",")))
+			       do (setf j-roles
+					(concatenate 'string j-roles (to-json-string item :xtm-id xtm-id) ",")))
 			    (concatenate 'string (subseq j-roles 0 (- (length j-roles) 1)) "]"))
 			  "null"))))
-    (concatenate 'string "{" itemIdentity "," type "," scope "," role "}")))
\ No newline at end of file
+    (concatenate 'string "{" itemIdentity "," type "," scope "," role "}")))
+
+
+(defmethod to-json-string ((instance TopicMapC) &key (xtm-id d:*current-xtm*))
+  "returns the ItemIdentifier's uri"
+  (declare (ignorable xtm-id))
+  (let ((ii (item-identifiers instance)))
+    (when ii
+      (uri (first ii)))))
+
+
+(defmethod to-json-string ((instance FragmentC) &key (xtm-id d:*current-xtm*))
+  "transforms an FragmentC object to a json string,
+   which contains the main topic, all depending topicStubs
+   and all associations depending on the main topic"
+  (let ((main-topic
+	 (concatenate 'string "\"topic\":"
+		      (to-json-string (topic instance) :xtm-id xtm-id)))
+	(topicStubs
+	 (concatenate 'string "\"topicStubs\":"
+		      (if (referenced-topics instance)
+			  (let ((j-topicStubs "["))
+			    (loop for item in (referenced-topics instance)
+			       do (setf j-topicStubs (concatenate 'string j-topicStubs
+								  (to-json-topicStub-string item) ",")))
+			    (concatenate 'string (subseq j-topicStubs 0 (- (length j-topicStubs) 1)) "]"))
+			  "null")))
+	(associations
+	 (concatenate 'string "\"associations\":"
+		      (if (associations instance)
+			  (let ((j-associations "["))
+			    (loop for item in (associations instance)
+			       do (setf j-associations
+					(concatenate 'string j-associations
+						     (to-json-string item :xtm-id xtm-id) ",")))
+			    (concatenate 'string (subseq j-associations 0 (- (length j-associations) 1)) "]"))
+			  "null")))
+	(tm-ids
+	 (concatenate 'string "\"tm-ids\":"
+		      (if (in-topicmaps (topic instance))
+			  (let ((j-tm-ids "["))
+			    (loop for item in (in-topicmaps (topic instance))
+			       do (setf j-tm-ids (concatenate 'string j-tm-ids "\""
+							      (d:uri (first (d:item-identifiers item))) "\",")))
+			    (concatenate 'string (subseq j-tm-ids 0 (- (length j-tm-ids) 1)) "]"))
+			  "null"))))
+    (concatenate 'string "{" main-topic "," topicStubs "," associations "," tm-ids "}")))
\ No newline at end of file

Added: trunk/src/json/json_importer.lisp
==============================================================================
--- (empty file)
+++ trunk/src/json/json_importer.lisp	Mon Mar  9 18:20:10 2009
@@ -0,0 +1,630 @@
+(defpackage :json-importer
+  (:use :cl :json :datamodel :xml-importer)
+  (:export :json-to-elem
+	   :*json-xtm*))
+
+(in-package :json-importer)
+
+;; the json schema for our datamodel is in "docs/xtm_json.txt"
+
+
+(defvar *json-xtm* "json-xtm"); Represents the currently active TM of the JSON-Importer
+
+
+(defun json-to-elem(json-string &key (xtm-id *json-xtm*))
+  "creates all objects (topics, topic stubs, associations)
+   of the passed json-decoded-list (=fragment)"
+  (when json-string
+    (let ((fragment-values
+	   (get-fragment-values-from-json-list
+	    (json:decode-json-from-string json-string))))
+      (declare (string json-string))
+      (let ((topic-values (getf fragment-values :topic))
+	    (topicStubs-values (getf fragment-values :topicStubs))
+	    (associations-values (getf fragment-values :associations))
+	    (rev (get-revision))) ; creates a new revision, equal for all elements of the passed fragment
+;	    (xtm-id "json-xtm"))
+	(xml-importer:with-tm (rev xtm-id (first (getf fragment-values :tm-ids)))
+	  (loop for topicStub-values in (append topicStubs-values (list topic-values))
+	     do (json-to-stub topicStub-values rev :tm xml-importer::tm :xtm-id xtm-id))
+	  (json-merge-topic topic-values rev :tm xml-importer::tm :xtm-id xtm-id)
+	  (loop for association-values in associations-values
+	     do (json-to-association association-values rev :tm xml-importer::tm)))))))
+
+
+(defun json-to-association (json-decoded-list start-revision
+			    &key tm )
+  "creates an association element of the passed json-decoded-list"
+  (elephant:ensure-transaction (:txn-nosync t) 
+    (let 
+        ((item-identifiers 
+          (map 'list #'(lambda(uri)
+			 (make-identifier 'ItemIdentifierC uri start-revision))
+	       (getf json-decoded-list :itemIdentities)))
+         (instance-of
+          (psis-to-topic (getf json-decoded-list :type)))
+         (themes
+          (json-to-scope (getf json-decoded-list :scopes)))
+         (roles 
+          (map 'list #'(lambda(role-values)
+			 (json-to-role role-values start-revision))
+	       (getf json-decoded-list :roles))))
+      (declare (list json-decoded-list))
+      (declare (integer start-revision))
+      (declare (TopicMapC tm))
+      (setf roles (xml-importer::set-standard-role-types roles))
+      (add-to-topicmap tm 
+		       (make-construct 'AssociationC
+				       :start-revision start-revision
+				       :item-identifiers item-identifiers
+				       :instance-of instance-of
+				       :themes themes
+				       :roles roles)))))
+    
+
+(defun json-to-role (json-decoded-list start-revision)
+  "creates a role element"
+  (when json-decoded-list
+  (elephant:ensure-transaction (:txn-nosync t) 
+    (let
+        ((item-identifiers
+          (map 'list #'(lambda(uri)
+			 (make-identifier 'ItemIdentifierC uri start-revision))
+	       (getf json-decoded-list :itemIdentities)))
+         (instance-of
+          (psis-to-topic (getf json-decoded-list :type)))
+         (player
+	  (psis-to-topic (getf json-decoded-list :topicRef))))
+      (declare (list json-decoded-list))
+      (declare (integer start-revision))
+      (unless player
+        (error "Role in association with topicref ~a not complete" (getf json-decoded-list :topicRef)))
+      (list :instance-of instance-of :player player :item-identifiers item-identifiers)))))
+
+
+(defun json-merge-topic (json-decoded-list start-revision
+                         &key tm (xtm-id *json-xtm*))
+  "merges the a topic by setting the name, occurrence and instanceOf
+   elements from the json-decoded-list"
+  (when json-decoded-list
+    (elephant:ensure-transaction (:txn-nosync t) 
+      (let ((top
+	     (d:get-item-by-id
+	      (getf json-decoded-list :id)
+	      :revision start-revision
+	      :xtm-id xtm-id)))
+	(declare (list json-decoded-list))
+	(declare (integer start-revision))
+	(declare (TopicMapC tm))
+	(unless top
+	  (error "topic ~a could not be found" (getf json-decoded-list :id)))
+
+	(let ((instanceof-topics
+	       (remove-duplicates
+		(map 'list
+		     #'psis-to-topic
+		     (getf json-decoded-list :instanceOfs)))))
+
+	  (loop for name-values in (getf json-decoded-list :names)
+	     do (json-to-name name-values top start-revision))
+
+	  (loop for occurrence-values in (getf json-decoded-list :occurrences)
+	     do (json-to-occurrence occurrence-values top start-revision))
+	  (dolist (instanceOf-top instanceof-topics)
+	    (json-create-instanceOf-association instanceOf-top top start-revision :tm tm))
+;	  (add-to-topicmap tm top) ; will be done in "json-to-stub"
+	  top)))))
+
+
+(defun json-to-stub(json-decoded-list start-revision &key tm (xtm-id *json-xtm*))
+  "creates a topic stub from the passed json-decoded list"
+  (when json-decoded-list
+    (elephant:ensure-transaction (:txn-nosync t) 
+      (let ((item-identifiers
+	     (map 'list #'(lambda(uri)
+			    (make-identifier 'ItemIdentifierC uri start-revision))
+		  (getf json-decoded-list :itemIdentities)))
+	    (subject-identifiers
+	     (map 'list #'(lambda(uri)
+			    (make-identifier 'PersistentIdC uri start-revision))
+		  (getf json-decoded-list :subjectIdentifiers)))
+	    (subject-locators
+	     (map 'list #'(lambda(uri)
+			    (make-identifier 'SubjectLocatorC uri start-revision))
+		  (getf json-decoded-list :subjectLocators))))
+	;; all topic stubs has to be added top a topicmap object in this method
+	;; becuase the only one topic that is handled in "json-merge-topic"
+	;; is the main topic of the fragment
+	(let ((top
+	       (make-construct 'TopicC :start-revision start-revision
+				       :item-identifiers item-identifiers
+				       :locators subject-locators
+				       :psis subject-identifiers
+				       :topicid (getf json-decoded-list :id)
+				       :xtm-id xtm-id)))
+	  (add-to-topicmap tm top)
+	  top)))))
+	
+
+(defun json-to-occurrence (json-decoded-list top start-revision)
+  "Creates an occurrence element"
+  (when json-decoded-list
+    (let
+      ((themes
+        (json-to-scope (getf json-decoded-list :scopes)))
+       (item-identifiers
+	(map 'list #'(lambda(uri)
+		       (make-identifier 'ItemIdentifierC uri start-revision))
+	     (getf json-decoded-list :itemIdentities)))
+       (instance-of 
+        (psis-to-topic (getf json-decoded-list :type)))
+       (occurrence-value
+	(json-to-resourceX json-decoded-list)))
+      
+      (unless occurrence-value
+	(error "OccurrenceC: one of resourceRef and resourceData must be set"))
+      (make-construct 'OccurrenceC 
+		      :start-revision start-revision
+		      :topic top
+		      :themes themes
+		      :item-identifiers item-identifiers
+		      :instance-of instance-of
+		      :charvalue (getf occurrence-value :data)
+		      :datatype (getf occurrence-value :type)))))
+
+
+(defun make-identifier (classsymbol uri start-revision)
+  "creates an instance of a PersistentIdc, SubjectlocatorC or
+   ItemIdentifierC"
+  (declare (symbol classsymbol))
+  (declare (string uri))
+  (declare (integer start-revision))
+  (let ((id (make-instance classsymbol
+			   :uri uri
+			   :start-revision start-revision)))
+    id))
+
+
+(defun json-to-scope (json-decoded-list)
+  "Generate set of themes (= topics) from this scope element and
+   return that set. If the input is nil, the list of themes is empty"
+  (when json-decoded-list
+    (let ((tops
+	   (map 'list #'psis-to-topic json-decoded-list)))
+      (declare (list json-decoded-list))
+      (unless (>= (length tops) 1)
+        (error "need at least one topic in a scope"))
+      tops)))
+
+
+(defun psis-to-topic(psis)
+  "searches for a topic of the passed psis-list describing
+   exactly one topic"
+  (when psis
+    (let ((top
+	   (let ((psi
+		  (loop for uri in psis
+		     when (elephant:get-instance-by-value
+			   'd:PersistentIdC 'd:uri uri)
+		     return (elephant:get-instance-by-value
+			     'd:PersistentIdC 'd:uri uri))))
+	     (when psi
+	       (d:identified-construct psi)))))
+      (unless top
+	(error (make-condition 'missing-reference-error
+			       :message (format nil "psis-to-topic: could not resolve reference ~a" psis))))
+      top)))
+
+
+(defun json-to-name (json-decoded-list top start-revision)
+  "creates a name element (NameC) of the passed json-decoded-list"
+  (when json-decoded-list
+    (let ((item-identifiers
+	   (map 'list #'(lambda(uri)
+			  (make-identifier 'ItemIdentifierC uri start-revision))
+		(getf json-decoded-list :itemIdentities)))
+	  (namevalue (getf json-decoded-list :value))
+	  (themes
+	   (json-to-scope (getf json-decoded-list :scopes)))
+	  (instance-of
+	   (psis-to-topic (getf json-decoded-list :type))))
+      (declare (list json-decoded-list))
+      (declare (TopicC top))
+  
+      (unless namevalue
+        (error "A name must have exactly one namevalue"))
+
+      (let ((name (make-construct 'NameC 
+				  :start-revision start-revision
+				  :topic top
+				  :charvalue namevalue
+				  :instance-of instance-of
+				  :item-identifiers item-identifiers
+				  :themes themes)))
+	(loop for variant in (getf json-decoded-list :variants)
+	   do (json-to-variant variant name start-revision))
+	;(json-to-variant (getf json-decoded-list :variants) name start-revision)
+	name))))
+
+
+(defun json-to-variant(json-decoded-list name start-revision)
+  "creates a variant element (VariantC) of the passed json-decoded-list"
+  (when json-decoded-list
+    (let ((item-identifiers
+	   (map 'list #'(lambda(uri)
+			  (make-identifier 'ItemIdentifierC uri start-revision))
+		(getf json-decoded-list :itemIdentities)))
+	  (themes
+	   (remove-duplicates (append (d:themes name)
+				      (json-to-scope (getf json-decoded-list :scopes)))))
+	  (variant-value
+	   (json-to-resourceX json-decoded-list)))
+      (declare (list json-decoded-list))
+      ;(declare (NameC name))
+      (make-construct 'VariantC
+		      :start-revision start-revision
+		      :item-identifiers item-identifiers
+		      :themes themes
+		      :charvalue (getf variant-value :data)
+		      :datatype (getf variant-value :type)
+		      :name name))))
+
+
+(defun json-to-resourceX(json-decoded-list)
+  "creates a resourceRef or resourceData element"
+  (when json-decoded-list
+    (let ((resourceRef
+	   (getf json-decoded-list :resourceRef))
+	  (resourceData
+	   (getf json-decoded-list :resourceData)))
+      (declare (list json-decoded-list))
+      (let ((value
+	     (if resourceRef
+		 (list :data resourceRef
+		       :type "http://www.w3.org/2001/XMLSchema#anyURI")
+		 (list :data (getf resourceData :value)
+		       :type (if (getf resourceData :datatype)
+				 (getf resourceData :datatype)
+				 "http://www.w3.org/2001/XMLSchema#string")))))
+	(unless (getf value :data)
+	  (error "json-to-resourceX: one of resourceRef or resourceData must be set"))
+	value))))
+
+
+(defun json-create-instanceOf-association (supertype player2-obj start-revision 
+                                      &key tm)
+  "handle the instanceOf element. The instanceOf element is different
+  from all the others in that it is not modelled one to one, but
+  following the suggestion of the XTM 2.0 spec (4.9) and the
+  TMDM (7.2) as an association"
+
+  (declare (TopicC supertype))
+  (declare (TopicC player2-obj))
+  (declare (TopicMapC tm))
+  (let
+      ((associationtype 
+        (get-item-by-psi constants:*type-instance-psi*))
+       (roletype1
+        (get-item-by-psi constants:*type-psi*))
+       (roletype2
+        (get-item-by-psi constants:*instance-psi*))
+       (player1 supertype))
+
+    (unless (and associationtype roletype1 roletype2)
+      (error "Error in the creation of an instanceof association: core topics are missing"))
+
+    (add-to-topicmap 
+     tm
+     (make-construct 
+      'AssociationC
+      :item-identifiers nil
+      :themes nil
+      :start-revision start-revision
+      :instance-of associationtype
+      :roles (list (list :instance-of roletype1 :player player1)
+                   (list :instance-of roletype2 :player player2-obj))))))
+
+
+(defun get-fragment-values-from-json-list(json-decoded-list)
+  "returns all fragment values of the passed json-decoded-list
+   as a named list"
+  (when json-decoded-list
+    (let ((topic nil)
+	  (topicStubs nil)
+	  (associations nil)
+	  (tm-ids nil))
+      (declare (list json-decoded-list))
+      (loop for j-elem in json-decoded-list
+	 do (cond
+	      ((string= (car j-elem) :topic)
+	       (setf topic (cdr j-elem)))
+	      ((string= (car j-elem) :topic-Stubs)
+	       (setf topicStubs (cdr j-elem)))
+	      ((string= (car j-elem) :associations)
+	       (setf associations (cdr j-elem)))
+	      ((string= (car j-elem) :tm-ids)
+	       (setf tm-ids (cdr j-elem)))
+	      (t
+	       (error "json-importer:get-fragment-values-from-json-string:
+                       bad item-specifier found in json-list"))))
+      (unless topic
+	(error "json-importer:get-fragment-values-from-json-string: the element topic must be set"))
+      (unless (= (length tm-ids) 1)
+	(error "There must be given exactly one tm-id in the tm-ids list"))
+      (let ((topic-list (get-topic-values-from-json-list topic))
+	    (topicStubs-list (map 'list #'get-topicStub-values-from-json-list topicStubs))
+	    (associations-list (map 'list #'get-association-values-from-json-list associations)))
+	(list :topic topic-list
+	      :topicStubs topicStubs-list
+	      :associations associations-list
+	      :tm-ids tm-ids)))))
+
+
+(defun get-topicStub-values-from-json-list (json-decoded-list)
+  "returns all topicStub values of the passed json-decoded-list
+   as a named list"
+  (when json-decoded-list
+    (let ((id nil)
+	  (itemIdentities nil)
+	  (subjectLocators nil)
+	  (subjectIdentifiers nil))
+      (declare (list json-decoded-list))
+      (loop for j-elem in json-decoded-list
+	 do (cond
+	      ((string= (car j-elem) :ID)
+	       (setf id (cdr j-elem)))
+	      ((string= (car j-elem) :item-Identities)
+	       (setf itemIdentities (cdr j-elem)))
+	      ((string= (car j-elem) :subject-Locators)
+	       (setf subjectLocators (cdr j-elem)))
+	      ((string= (car j-elem) :subject-Identifiers)
+	       (setf subjectIdentifiers (cdr j-elem)))
+	      (t
+	       (error "json-importer:get-topicStub-values-from-json-string:
+                       bad item-specifier found in json-list"))))
+       (unless (or itemIdentities subjectLocators subjectIdentifiers)
+	(error "json-importer:get-topicStub-values-from-json-string: one of the elements
+                  itemIdentity, sbjectLocator or subjectIdentifier must be set"))
+      (unless id
+	(error "json-importer:get-topic-valuesStub-from-json-string: the element id must be set"))
+      (list :id id
+	    :itemIdentities itemIdentities
+	    :subjectLocators subjectLocators
+	    :subjectIdentifiers subjectIdentifiers))))
+      
+
+(defun get-topic-values-from-json-list (json-decoded-list)
+  "extracts all values of the passed json-list and
+   returns them as a named list"
+  (when json-decoded-list
+    (let ((id nil)
+	  (itemIdentities nil)
+	  (subjectLocators nil)
+	  (subjectIdentifiers nil)
+	  (instanceOfs nil)
+	  (names nil)
+	  (occurrences nil))
+      (declare (list json-decoded-list))
+      (loop for j-elem in json-decoded-list
+	 do (cond
+	      ((string= (car j-elem) :ID)
+	       (setf id (cdr j-elem)))
+	      ((string= (car j-elem) :item-Identities) ;json-decoder transforms camelcase to '-' from
+	       (setf itemIdentities (cdr j-elem)))
+	      ((string= (car j-elem) :subject-Locators)
+	       (setf subjectLocators (cdr j-elem)))
+	      ((string= (car j-elem) :subject-Identifiers)
+	       (setf subjectIdentifiers (cdr j-elem)))
+	      ((string= (car j-elem) :instance-Ofs)
+	       (setf instanceOfs (cdr j-elem)))
+	      ((string= (car j-elem) :names)
+	       (setf names (cdr j-elem)))
+	      ((string= (car j-elem) :occurrences)
+	       (setf occurrences (cdr j-elem)))
+	      (t
+	       (error "json-importer:get-topic-values-from-json-string:
+                       bad item-specifier found in json-list ~a" (car j-elem)))))
+      (unless (or itemIdentities subjectLocators subjectIdentifiers)
+	(error "json-importer:get-topic-values-from-json-string: one of the elements
+                  itemIdentity, sbjectLocator or subjectIdentifier must be set"))
+      (unless id
+	(error "json-importer:get-topic-values-from-json-string: the element id must be set"))
+      (let ((names-list (map 'list #'get-name-values-from-json-list names))
+	    (occurrences-list (map 'list #'get-occurrence-values-from-json-list occurrences)))
+	(list :id id
+	      :itemIdentities itemIdentities
+	      :subjectLocators subjectLocators
+	      :subjectIdentifiers subjectIdentifiers
+	      :instanceOfs instanceOfs
+	      :names names-list
+	      :occurrences occurrences-list)))))
+
+
+(defun get-name-values-from-json-list (json-decoded-list)
+  "returns all element values of a name element as
+   a named list"
+  (when json-decoded-list
+    (let ((itemIdentities nil)
+	  (type nil)
+	  (scopes nil)
+	  (value nil)
+	  (variants nil))
+      (declare (list json-decoded-list))
+      (loop for j-elem in json-decoded-list
+	 do (cond
+	      ((string= (car j-elem) :item-Identities)
+	       (setf itemIdentities (cdr j-elem)))
+	      ((string= (car j-elem) :type)
+	       (setf type (cdr j-elem)))
+	      ((string= (car j-elem) :scopes)
+	       (setf scopes (cdr j-elem)))
+	      ((string= (car j-elem) :value)
+	       (setf value (cdr j-elem)))
+	      ((string= (car j-elem) :variants)
+	       (setf variants (cdr j-elem)))
+	      (t
+	       (error "json-importer:get-name-values-from-json-list:
+                       bad item-specifier found in json-list"))))
+      (unless value
+	(error "json-importer:get-name-values-from-json-list: value must be set"))
+      (let ((variants-list (map 'list #'get-variant-values-from-json-list variants)))
+	(list :itemIdentities itemIdentities
+	      :type type
+	      :scopes scopes
+	      :value value
+	      :variants variants-list)))))
+	    
+
+(defun get-variant-values-from-json-list (json-decoded-list)
+  "returns all element values of a variant element as
+   a named list"
+  (when json-decoded-list
+    (let ((itemIdentities nil)
+	  (scopes nil)
+	  (resourceRef nil)
+	  (resourceData nil))
+      (declare (list json-decoded-list))
+      (loop for j-elem in json-decoded-list
+	 do (cond
+	      ((string= (car j-elem) :item-Identities)
+	       (setf itemIdentities (cdr j-elem)))
+	      ((string= (car j-elem) :scopes)
+	       (setf scopes (cdr j-elem)))
+	      ((string= (car j-elem) :resource-Ref)
+	       (setf resourceRef (cdr j-elem)))
+	      ((string= (car j-elem) :resource-Data)
+	       (setf resourceData (cdr j-elem)))
+	      (t
+	       (error "json-importer:get-variant-values-from-json-list:
+                       bad item-specifier found in json-list"))))
+      (when (or (and (not resourceRef)
+		     (not resourceData))
+		(and resourceRef resourceData))
+	(error "json-importer:get-variant-values-from-json-list: ONE of the elements
+                  resourceRef or resourceData must be set"))
+      (let ((resourceData-list (get-resourceData-values-from-json-list resourceData)))
+	(list :itemIdentities itemIdentities  
+	      :scopes scopes
+	      :resourceRef resourceRef
+	      :resourceData resourceData-list)))))
+  
+
+(defun get-resourceData-values-from-json-list (json-decoded-list)
+  "returns the resourceData value and the datatype value, if there
+   is no datatype given, there will be set the standard type string"
+  (when json-decoded-list
+    (let ((value nil)
+	  (datatype nil))
+      (declare (list json-decoded-list))
+      (loop for j-elem in json-decoded-list
+	 do (cond
+	      ((string= (car j-elem) :value)
+	       (setf value (cdr j-elem)))
+	      ((string= (car j-elem) :datatype)
+	       (setf datatype (cdr j-elem)))
+	      (t
+	       (error "json-importer:get-resourceData-values-from-json-list:
+                       bad item-specifier found in json-list"))))
+      (unless value
+	(error "json-importer:get-resourceData-values-from-json-list: resourceData must have a value"))
+      (list :value value
+	    :datatype (if datatype datatype "http://www.w3.org/2001/XMLSchema#string")))))
+
+
+(defun get-occurrence-values-from-json-list (json-decoded-list)
+  "returns all occurrence values of the passed json-list as
+   a named list"
+  (when json-decoded-list
+    (let ((itemIdentities nil)
+	  (type nil)
+	  (scopes nil)
+	  (resourceRef nil)
+	  (resourceData nil))
+      (declare (list json-decoded-list))
+      (loop for j-elem in json-decoded-list
+	 do (cond
+	      ((string= (car j-elem) :item-Identities)
+	       (setf itemIdentities (cdr j-elem)))
+	      ((string= (car j-elem) :type)
+	       (setf type (cdr j-elem)))
+	      ((string= (car j-elem) :scopes)
+	       (setf scopes (cdr j-elem)))
+	      ((string= (car j-elem) :resource-Ref)
+	       (setf resourceRef (cdr j-elem)))
+	      ((string= (car j-elem) :resource-Data)
+	       (setf resourceData (cdr j-elem)))
+	      (t
+	       (error "json-importer:get-occurrence-values-from-json-list:
+                       bad item-specifier found in json-list"))))
+      (when (or (and (not resourceRef)
+		     (not resourceData))
+		(and resourceRef resourceData))
+	(error "json-importer:get-occurrence-values-from-json-list: ONE of the elements
+                  resourceRef or resourceData must be set"))
+      (unless type
+	(error "json-importer:get-occurrence-values-from-json-list: type must be set"))
+      (let ((resourceData-list (get-resourceData-values-from-json-list resourceData)))
+	(list :itemIdentities itemIdentities
+	      :type type
+	      :scopes scopes
+	      :resourceRef resourceRef
+	      :resourceData resourceData-list)))))
+
+
+(defun get-association-values-from-json-list (json-decoded-list)
+  "extracts all values of the passed json-list and
+   returns them as a named list"
+  (when json-decoded-list
+    (let ((itemIdentities nil)
+	  (type nil)
+	  (scopes nil)
+	  (roles nil))
+      (declare (list json-decoded-list))
+      (loop for j-elem in json-decoded-list
+	 do (cond
+	      ((string= (car j-elem) :item-Identities)
+	       (setf itemIdentities (cdr j-elem)))
+	      ((string= (car j-elem) :type)
+	       (setf type (cdr j-elem)))
+	      ((string= (car j-elem) :scopes)
+	       (setf scopes (cdr j-elem)))
+	      ((string= (car j-elem) :roles)
+	       (setf roles (cdr j-elem)))
+	      (t
+	       (error "json-importer:get-association-values-from-json-list:
+                       bad item-specifier found in json-list"))))
+      (unless (and type roles)
+	(error "json-importer:get-occurrence-values-from-json-list: type and role must be set"))
+      (let ((roles-list (map 'list #'get-role-values-from-json-list roles)))
+	(list :itemIdentities itemIdentities
+	      :type type
+	      :scopes scopes
+	      :roles roles-list)))))
+  
+
+(defun get-role-values-from-json-list (json-decoded-list)
+  "extracts all values of the passed json-list and
+   returns them as a named list"
+  (when json-decoded-list
+    (let ((itemIdentities nil)
+	  (type nil)
+	  (topicRef nil))
+      (declare (list json-decoded-list))
+      (loop for j-elem in json-decoded-list
+	 do (cond
+	      ((string= (car j-elem) :item-Identities)
+	       (setf itemIdentities (cdr j-elem)))
+	      ((string= (car j-elem) :type)
+	       (setf type (cdr j-elem)))
+	      ((string= (car j-elem) :topic-Ref)
+	       (setf topicRef (cdr j-elem)))
+	      (t
+	       (error "json-importer:get-role-values-from-json-list:
+                       bad item-specifier found in json-list"))))
+      (unless (and type topicRef)
+	(error "json-importer:get-occurrence-values-from-json-list: type and topicRef must be set"))
+      (list :itemIdentities itemIdentities
+	    :type type
+	    :topicRef topicRef))))
+
+

Added: trunk/src/json/json_interface.html
==============================================================================
--- (empty file)
+++ trunk/src/json/json_interface.html	Mon Mar  9 18:20:10 2009
@@ -0,0 +1,231 @@
+<html>
+  <head>
+    <title>isidorus</title>
+    <script type="text/javascript">
+     // --- here we can handle timeouts of the passed XMLHttpRequest-objects
+     // --- this function has to be set and cleared in every XMLHttpRequest-object
+     function ajaxTimeout(xhr){
+	 xhr.abort();
+	 alert("The AJAX request timed out. Did you lose network connectivity for some reason?");
+     }
+
+     // --- the timeout interval in seconds
+     const TIMEOUT = 5000;
+     // --- the XMLHttpRequest base url
+     const BASE_URL = "http://localhost:8000/json/psi/";
+     const OWN_URL = "http://localhost:8000/isidorus";
+
+
+     function back()
+     {
+	 window.location.href = OWN_URL;
+     }
+
+
+     // --- creates a XMLHttpReques object
+     function connect()
+     {
+	 try { return new XMLHttpRequest(); } catch(err){}
+	 try { return new AcitveXObject("Msxml2.XMLHTTP"); } catch(err){}
+	 try { return new ActiveXObject("Microsoft.XMLHTTP"); } catch(err){}
+
+	 alert("error creating request object");
+	 return null;
+     }
+
+
+     // ========================================================================
+     // --- get request -> aks for json-data
+     // ========================================================================
+     var xhrGet = null;
+
+     // --- creates a XMLHttpReques object
+     function connectGet()
+     {
+	 // --- firefox
+	 try{ return new XMLHttpRequest(); } catch(err){}
+
+	 // --- internet explorer
+	 try{ return new ActiveXObject("Msxml2.XMLHTTP"); } catch(err){}
+	 try{ return new ActiveXObject("Microsoft.XMLHTTP"); } catch(err){}
+
+	 alert("error creating request object");
+	 return null;
+     }
+
+
+     // --- handles the json response
+     function handleJson()
+     {
+	 if(xhrGet.readyState == 4){ // state 4 --> response is complete
+	     if(xhrGet.status != 200){
+		 alert("error: " + xhrGet.status);
+		 return false;
+	     }
+	     
+	     // --- resets the timeout
+	     clearTimeout(xhrGet.timeout);
+
+	     // --- handle the data
+	     var json = eval("(" + xhrGet.responseText + ")");
+	     var psis = json.topic.subjectIdentifiers;
+	     document.getElementById("psis").innerHTML = "";
+	     for each(var psi in psis)
+			 document.getElementById("psis").innerHTML += "psi: " + psi + '<br/>';
+	     
+	     document.getElementById("real_text").value = xhrGet.responseText;
+	     //alert("header: " + xhrGet.getAllResponseHeaders());
+	 }
+	 else{
+	     return false;
+	 }
+     }
+
+
+     // --- sends a request for the json data
+     function getData(xhr)
+     {
+	 var topic_psi = document.getElementById("topic_psi").value;
+	 var url = BASE_URL + topic_psi;
+
+	 // --- sets the timeout for this XMLHttpRequest object; 5 seconds
+	 xhrGet.timeout = setTimeout("ajaxTimeout(xhrGet);", TIMEOUT);
+
+	 try{
+	 xhrGet.open("GET", url, true); // true --> asynchronous call, so the user is able to continue working on other things
+	 }catch(err) {alert("err: " + err); }
+
+	 // --- registers a callback handler for the readystatechange event of the XMLHttpRequest/ActiveXObject-Object
+	 xhrGet.onreadystatechange = handleJson;
+	 xhrGet.send(null);
+     }
+
+
+     // --- calls all necessary functions to get a fragment belonging to the
+     // --- psi of the topic_psi text field
+     function doIt()
+     {
+	 xhrGet = connectGet();
+
+	 if(xhrGet != null)
+	     getData(xhrGet);
+     }
+
+     // ========================================================================
+     // --- put request -> commit json-data
+     // ========================================================================
+     var xhrPut = null;
+
+     // --- commits the textarea's json data to the server
+     function commitJson()
+     {
+	 xhrPut = connect();
+
+	 if(xhrPut != null)
+	     sendData(xhrPut);
+     }
+
+
+     // --- handles the committing of json data
+     function handleCommit()
+     {
+	 alert("readyState: " + xhrPut.readyState + "\nstatus: " + xhrPut.status + "\nresponsetext: " + xhrPut.responseText);
+	 if(xhrPut.readyState == 4){ // state 4 --> response is complete
+	     //if(xhrPut.status == 200){
+	     // alert("error: " + xhrPut.status);
+	     // return false;
+	     //}
+
+	     // --- resets the timeout
+	     clearTimeout(xhrPut.timeout);
+	     alert("data commited successfully");
+	     //doIt();
+	 }
+	 else{
+	     return false;
+	 }
+     }
+
+
+     // --- sends the json data to the server
+     function sendData(xhr)
+     {
+	 var json =  document.getElementById("real_text").value;
+	 var topicPsi = document.getElementById("topic_psi").value;
+	 var url = BASE_URL + topicPsi;
+	 xhrPut.open("PUT", url, true);
+
+	 // --- sets the timeout for this XMLHttpRequest object; 5 seconds
+	 xhrPut.timeout = setTimeout("ajaxTimeout(xhrPut);", TIMEOUT);
+
+	 // --- registers a callback handler for the readystatechange event of the XMLHttpRequest/ActiveXObject-Object
+	 xhrPut.onreadystatechange = handleCommit;
+	 xhrPut.setRequestHeader("Content-type", "application/json");
+	 xhrPut.send(json);
+     }
+
+
+     // ========================================================================
+     // --- post request -> commit json-data
+     // ========================================================================
+     var xhrPost = null;
+
+
+     function commitJsonPost()
+     {
+	 xhrPost = connect();
+
+	 if(xhrPost != null)
+	     sendDataPost(xhrPost);
+     }
+
+
+     function handlePostCommit()
+     {
+	 alert("readyState: " + xhrPost.readyState + "\nstatus: " + xhrPost.status + "\nresponsetext: " + xhrPost.responseText);
+	 if(xhrPost.readyState == 4){ // state 4 --> response is complete
+	     //if(xhrPut.status == 200){
+	     // alert("error: " + xhrPut.status);
+	     // return false;
+	     //}
+
+	     // --- resets the timeout
+	     clearTimeout(xhrPost.timeout);
+	     alert("data commited successfully");
+	     //doIt();
+	 }
+	 else{
+	     return false;
+	 }
+     }
+
+
+     function sendDataPost(xhr)
+     {
+	 var json =  document.getElementById("real_text").value;
+	 var topicPsi = document.getElementById("topic_psi").value;
+	 var url = BASE_URL + topicPsi;
+	 xhrPost.open("POST", url, true);
+
+	 // --- sets the timeout for this XMLHttpRequest object; 5 seconds
+	 xhrPost.timeout = setTimeout("ajaxTimeout(xhrPost);", TIMEOUT);
+
+	 // --- registers a callback handler for the readystatechange event of the XMLHttpRequest/ActiveXObject-Object
+	 xhrPost.onreadystatechange = handlePostCommit;
+     }
+
+
+    </script>
+  </head>
+  <body>
+    <div id="content" style="width: 80%; height: 80%; border: dashed 1px;">
+      <input id="topic_psi" type="text" value="http://psi.egovpt.org/types/topicInTaxonomy" name="topic_psi" style="margin-left:10px; margin-top:10px;"/>
+      <input type="button" onclick="doIt();" value="get json" style="margin-top:10px;"/>
+      <div id="psis" style="background-color: silver; width: 70%; margin: 10px;"></div>
+      <textarea id ="real_text" name="text" cols="120" rows="10" style="margin: 10px;"></textarea><br/>
+      <input type="button" onclick="commitJson()" value="commit json via PUT" style="margin-left: 10px;"/>
+      <input type="button" onclick="commitJsonPost()" value="commit json via POST" style="margin-left: 10px; margin-right: 10px;"/>
+      <input type="button" onclick="back()" value="back"/>
+    </div>
+  </body>
+</html>

Modified: trunk/src/model/changes.lisp
==============================================================================
--- trunk/src/model/changes.lisp	(original)
+++ trunk/src/model/changes.lisp	Mon Mar  9 18:20:10 2009
@@ -50,7 +50,12 @@
   (append
    (themes characteristic)
    (when (instance-of-p characteristic)
-     (list (instance-of characteristic)))))
+     (list (instance-of characteristic)))
+   (when  (and (typep characteristic 'OccurrenceC)
+              (> (length (charvalue characteristic)) 0)
+              (eq #\# (elt (charvalue characteristic) 0)))
+     (list (get-item-by-id (subseq (charvalue characteristic)  1))))))
+
 
 (defmethod find-referenced-topics ((role RoleC))
   (append
@@ -140,6 +145,7 @@
    (topic :type TopicC
           :initarg :topic
           :accessor topic
+          :index t
           :documentation "changed topic (topicSI in Atom")
    (referenced-topics
     :type list
@@ -252,4 +258,23 @@
   (mapc (lambda (occ) (add-source-locator occ :revision revision :source-locator source-locator))
         (occurrences top))
   (mapc (lambda (ass) (add-source-locator ass :revision revision :source-locator source-locator))
-        (find-associations-for-topic top)))
\ No newline at end of file
+        (find-associations-for-topic top)))
+
+
+(defun get-latest-fragment-of-topic (topic-psi)
+  "returns the latest fragment of the passed topic-psi"
+  (declare (string topic-psi))
+  (let ((topic-psi topic-psi))
+    (let ((psi
+           (elephant:get-instance-by-value 'PersistentIdC 'uri topic-psi)))
+      (when psi
+        (let ((topic
+               (identified-construct psi)))
+          (when topic
+            (loop for current-revision in (versions topic)
+               do (get-fragments (start-revision current-revision)))
+            (let ((fragments
+                   (elephant:get-instances-by-value 'FragmentC 'topic topic)))
+              ;; maybe there are more fragments of this topic in different revisions,
+              ;; so we need to search the fragment with a certain revision
+              (first (sort fragments #'> :key 'revision)))))))))
\ No newline at end of file

Modified: trunk/src/model/datamodel.lisp
==============================================================================
--- trunk/src/model/datamodel.lisp	(original)
+++ trunk/src/model/datamodel.lisp	Mon Mar  9 18:20:10 2009
@@ -28,6 +28,7 @@
 	   :VariantC
 
            ;; functions and slot accessors
+           :in-topicmaps
            :add-to-topicmap
            :add-source-locator
            :associations
@@ -89,6 +90,7 @@
 	   :used-as-theme
 	   :variants
 	   :xor
+           :get-latest-fragment-of-topic
 
            :*current-xtm* ;; special variables
            :*TM-REVISION*
@@ -948,9 +950,9 @@
   (:method ((topic TopicC) &key (revision *TM-REVISION*))
     (filter-slot-value-by-revision topic 'used-as-theme :start-revision revision)))
 
-(defgeneric in-topicmaps (topic)
-  (:method ((topic TopicC))
-    (filter-slot-value-by-revision topic 'in-topicmaps :start-revision *TM-REVISION*)))
+(defgeneric in-topicmaps (topic &key revision)
+  (:method ((topic TopicC) &key (revision *TM-REVISION*))
+    (filter-slot-value-by-revision topic 'in-topicmaps :start-revision revision)))
 
 (defmethod initialize-instance :around ((instance TopicC) &key (psis nil) (locators nil))
   "implement the pseudo-initargs :topic-ids, :persistent-ids, and :subject-locators"
@@ -1313,6 +1315,10 @@
   (:index t))
 
 
+(defmethod in-topicmaps ((association AssociationC) &key (revision *TM-REVISION*))
+  (filter-slot-value-by-revision association 'in-topicmaps :start-revision revision))
+
+
 (defgeneric AssociationC-p (object)
   (:documentation "test if object is a of type AssociationC")
   (:method ((object t)) nil)
@@ -1439,11 +1445,13 @@
 
 (defmethod add-to-topicmap ((tm TopicMapC) (top TopicC))
   ;TODO: add logic not to add pure topic stubs unless they don't exist yet in the store
-  (elephant:add-association tm 'topics top)
+;  (elephant:add-association tm 'topics top) ;by adding the elephant association in this order, there will be missing one site of this association
+  (elephant:add-association top 'in-topicmaps tm)
   top)
 
 (defmethod add-to-topicmap ((tm TopicMapC) (ass AssociationC))
-  (elephant:add-association tm 'associations ass)
+   ;(elephant:add-association tm 'associations ass)
+  (elephant:add-association ass 'in-topicmaps tm)
   ass)
 
 (defgeneric in-topicmap (tm constr &key revision)

Modified: trunk/src/rest_interface/rest-interface.lisp
==============================================================================
--- trunk/src/rest_interface/rest-interface.lisp	(original)
+++ trunk/src/rest_interface/rest-interface.lisp	Mon Mar  9 18:20:10 2009
@@ -6,14 +6,20 @@
         :datamodel
         :exporter
         :xml-tools
-        :xml-importer)
+        :xml-importer
+	:json-exporter
+	:json-importer)
   (:export :import-fragments-feed
            :import-snapshots-feed
            :import-tm-feed
            :read-url
            :read-fragment-feed
            :start-tm-engine
-	   :shutdown-tm-engine))
+	   :shutdown-tm-engine
+	   :*json-rest-prefix*
+	   :*json-user-interface-url*
+	   :*json-user-interface-file-path*))
+
 
 (in-package :rest-interface)
 
@@ -63,17 +69,36 @@
 ;; 	(exporter:export-xtm-fragment fragment :xtm-format '1.0)
 ;; 	(format nil "<t:topicMap xmlns:t=\"http://www.topicmaps.org/xtm/1.0/\" xmlns:xlink=\"http://www.w3.org/1999/xlink\"/>"))))
 
-(defun make-json (&optional uri)
-  "returns a json-string of the topic with the passed psi-uri"
-  (assert uri)
-  (let ((topic
-	 (let ((psi
-		(elephant:get-instance-by-value 'd:PersistentIdC 'd:uri uri)))
-	   (when psi
-	     (d:identified-construct psi)))))
-    (if topic
-	(json-exporter:to-json-string topic)
-	(format nil "Could not find topic with psi \"~a\"" uri))))
+
+;;(defun make-json (&optional uri)
+;;  "returns a json-string of the topic with the passed psi-uri"
+;;  (assert uri)
+;;  ;decodes the url-encoding "%23" to "#" character (only the first which will be found)
+;;  (let ((identifier (let ((pos (search "%23" uri)))
+;;		      (if pos
+;;			  (let ((str-1 (subseq uri 0 pos))
+;;				(str-2 (if (> (length uri) (+ pos 3))
+;;					   (subseq uri (+ pos 3))
+;;					   "")))
+;;			    (concatenate 'string str-1 "#" str-2))
+;;			  uri)))
+;;	(http-method (request-method))
+;;	(external-format (flexi-streams:make-external-format :UTF-8 :eol-style :LF))) ;;is needed to get a string of the put-request
+;;    (if (eq http-method :GET)
+;;	(progn
+;;	  (setf (hunchentoot:content-type) "application/json")
+;;	  (let ((fragment
+;;		 (get-latest-fragment-of-topic identifier)))
+;;	    (if fragment
+;;		(handler-case (to-json-string fragment)
+;;		  (condition (err) (format nil "{\"fault\":\"~a\"}" err)))
+;;		"{}")))
+;;	(if (eq http-method :PUT)
+;;	    (let ((put-data (raw-post-data :external-format external-format :force-text t)))	      
+;;	      (handler-case (json-importer:json-to-elem put-data)
+;;		(condition () (setf (return-code) +http-internal-server-error+))))    
+;;	    (setf (return-code) +http-internal-server-error+))))) ; for all htt-methods except for get and post
+
 
 ;; (push 
 ;;  (create-regex-dispatcher "/feeds/?$" #'feeds) 
@@ -99,9 +124,9 @@
 ;;  (create-regex-dispatcher "/testtm/fragments/([0-9]+)$" #'fragments) 
 ;;  hunchentoot:*dispatch-table*)
 
-(push
- (create-regex-dispatcher "/json/psi/(.+)$" #'make-json)
- hunchentoot:*dispatch-table*)
+;;(push
+;; (create-regex-dispatcher "/json/psi/(.+)$" #'make-json)
+;; hunchentoot:*dispatch-table*)
     
 
 (defvar *server*)
@@ -118,6 +143,7 @@
    (xml-importer:get-store-spec repository-path))
   (load conffile)
   (publish-feed atom:*tm-feed*)
+  (set-up-json-interface)
   (setf *server* (hunchentoot:start-server :address host-name :port port)))
 
 (defun shutdown-tm-engine ()

Added: trunk/src/rest_interface/set-up-json-interface.lisp
==============================================================================
--- (empty file)
+++ trunk/src/rest_interface/set-up-json-interface.lisp	Mon Mar  9 18:20:10 2009
@@ -0,0 +1,112 @@
+(in-package :rest-interface)
+
+(defparameter *json-rest-prefix* "/json/psi")
+(defparameter *json-user-interface-url* "/isidorus")
+(defparameter *json-user-interface-file-path* "json/json_interface.html")
+
+(defun set-up-json-interface (&key (rest-prefix *json-rest-prefix*) (ui-url *json-user-interface-url*) (ui-file-path *json-user-interface-file-path*))
+  "registers the json im/exporter to the passed base-url in hunchentoot's dispatch-table
+   and also registers a file-hanlder to the html-user-interface"
+  (declare (string rest-prefix ui-url ui-file-path))
+  (let ((rest-regex (concatenate 'string rest-prefix "/(.+)$"))
+	(ui-regex (concatenate 'string ui-url "/?$")))
+    ;(format t "rest-interface: ~a~%user-interface: ~a~%user-interface-file-path: ~a~%" rest-regex ui-regex ui-file-path)
+    (push
+     (create-regex-dispatcher ui-regex #'(lambda()
+					 (hunchentoot:handle-static-file ui-file-path)))
+     hunchentoot:*dispatch-table*)
+    (push
+     (create-regex-dispatcher rest-regex
+			      #'(lambda (&optional uri)
+				  (assert uri)
+					;decodes the url-encoding "%23" to "#" character (only the first which will be found)
+				  (let ((identifier (let ((pos (search "%23" uri)))
+						      (if pos
+							  (let ((str-1 (subseq uri 0 pos))
+								(str-2 (if (> (length uri) (+ pos 3))
+									   (subseq uri (+ pos 3))
+									   "")))
+							    (concatenate 'string str-1 "#" str-2))
+							  uri)))
+					(http-method (request-method))
+					(external-format (flexi-streams:make-external-format :UTF-8 :eol-style :LF))) ;is needed to get a string of the put-request
+				    (with-open-file (stream "/home/lukas/Desktop/tmp2.txt" :direction :output :if-exists :supersede)
+				      (format stream "http-method: ~a~%" http-method))
+				    (cond
+				      ((eq http-method :GET)
+				       (progn
+					 (setf (hunchentoot:content-type) "application/json") ;RFC 4627
+					 (let ((fragment
+						(get-latest-fragment-of-topic identifier)))
+					   (if fragment
+					       (handler-case (to-json-string fragment)
+						 (condition (err) (progn
+								    (setf (hunchentoot:return-code) hunchentoot:+http-internal-server-error+)
+								    (format nil "<p style=\"color:red\">Condition: \"~a\"</p>" err))))
+					       "{}"))))
+				      ((eq http-method :PUT)
+				       (let ((put-data (hunchentoot:raw-post-data :external-format external-format :force-text t)))	      
+					 (handler-case (progn
+							 (json-importer:json-to-elem put-data)
+							 (setf (hunchentoot:return-code) hunchentoot:+http-ok+)
+							 (setf (hunchentoot:content-type) "text")
+							 (format nil "~a" hunchentoot:+http-ok+))
+					   (condition (err) (progn
+							      (setf (hunchentoot:return-code) hunchentoot:+http-internal-server-error+)
+							      (format nil "<p style=\"color:red\">Condition: \"~a\"</p>" err))))))
+				      ((eq http-method :POST)
+				       (let ((post-data (hunchentoot:raw-post-data :external-format external-format :force-text t)))
+					(with-open-file (stream "/home/lukas/Desktop/tmp.txt" :direction :output :if-exists :supersede)
+					  (format stream "post-data: ~a~%" post-data))
+					 (handler-case (progn
+							 (json-importer:json-to-elem post-data)
+							 (setf (hunchentoot:return-code) hunchentoot:+http-ok+)
+							 (setf (hunchentoot:content-type) "text")
+							 (format nil "~a" hunchentoot:+http-ok+))
+					   (condition (err) (progn
+							      (setf (hunchentoot:return-code) hunchentoot:+http-internal-server-error+)
+							      (format nil "<p style=\"color:red\">Condition: \"~a\"</p>" err))))))
+				      (t
+				       (progn ;for all htt-methods except for get and post
+					 (setf (hunchentoot:return-code) hunchentoot:+http-internal-server-error+)
+					 (format nil "<p style=\"color:red\">You have to use either the HTTP-Method \"GET\" or \"PUT\", but you used \"~a\"</p>" http-method)))))))
+     hunchentoot:*dispatch-table*)))
+
+
+
+;
+;				    (if (eq http-method :GET)
+;					(progn
+;					  (setf (hunchentoot:content-type) "application/json") ;RFC 4627
+;					  (let ((fragment
+;						 (get-latest-fragment-of-topic identifier)))
+;					    (if fragment
+;						(handler-case (to-json-string fragment)
+;						  (condition (err) (progn
+;								     (setf (hunchentoot:return-code) hunchentoot:+http-internal-server-error+)
+;								     (format nil "<p style=\"color:red\">Condition: \"~a\"</p>" err))))
+;						"{}")))
+;					(if (eq http-method :PUT)
+;					    (let ((put-data (hunchentoot:raw-post-data :external-format external-format :force-text t)))	      
+;					      (handler-case (progn
+;							      (json-importer:json-to-elem put-data)
+;							      (setf (hunchentoot:return-code) hunchentoot:+http-ok+)
+;							      (setf (hunchentoot:content-type) "text")
+;							      (format nil "~a" hunchentoot:+http-ok+))
+;						(condition (err) (progn
+;								   (setf (hunchentoot:return-code) hunchentoot:+http-internal-server-error+)
+;								   (format nil "<p style=\"color:red\">Condition: \"~a\"</p>" err)))))
+;					    (if (eq http-method :POST)
+;						(let ((post-data (hunchentoot:post-parameter "json-data")))
+;						  (handler-case (progn
+;							      (json-importer:json-to-elem post-data)
+;							      (setf (hunchentoot:return-code) hunchentoot:+http-ok+)
+;							      (setf (hunchentoot:content-type) "text")
+;							      (format nil "~a" hunchentoot:+http-ok+))
+;						    (condition (err) (progn
+;								       (setf (hunchentoot:return-code) hunchentoot:+http-internal-server-error+)
+;								       (format nil "<p style=\"color:red\">Condition: \"~a\"</p>" err)))))
+;						(progn ;for all htt-methods except for get and post
+;						  (setf (hunchentoot:return-code) hunchentoot:+http-internal-server-error+)
+;						  (format nil "<p style=\"color:red\">You have to use either the HTTP-Method \"GET\" or \"PUT\", but you used \"~a\"</p>" http-method))))))))
+;     hunchentoot:*dispatch-table*)))
\ No newline at end of file

Modified: trunk/src/unit_tests/json_test.lisp
==============================================================================
--- trunk/src/unit_tests/json_test.lisp	(original)
+++ trunk/src/unit_tests/json_test.lisp	Mon Mar  9 18:20:10 2009
@@ -3,13 +3,18 @@
    :common-lisp
    :xml-importer
    :json-exporter
+   :json-importer
    :datamodel
    :it.bese.FiveAM
    :unittests-constants
    :fixtures)
   (:export :test-to-json-string-topics
 	   :test-to-json-string-associations
-	   :run-json-tests))
+	   :test-to-json-string-fragments
+	   :test-get-fragment-values-from-json-list
+	   :run-json-tests
+	   :test-json-importer
+	   :test-json-importer-merge))
 
 
 (in-package :json-test)
@@ -26,7 +31,8 @@
       ((dir "data_base"))
     (with-fixture initialize-destination-db (dir)
       (xml-importer:setup-repository
-       *notificationbase.xtm* dir :xtm-id *TEST-TM*)
+       *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 ((t50a (get-item-by-id "t50a")))
@@ -56,12 +62,14 @@
 	    (is (string= t100-string json-string))))))))
 
 
+
 (test test-to-json-string-associations
   (let
       ((dir "data_base"))
     (with-fixture initialize-destination-db (dir)
       (xml-importer:setup-repository
-       *notificationbase.xtm* dir :xtm-id *TEST-TM*)
+       *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 ((t57 (get-item-by-id "t57"))
@@ -102,6 +110,826 @@
 	    (is (string= association-7-string json-string))))))))
 
 
+
+(test test-to-json-string-fragments
+  (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 ((frag-t100
+	     (get-latest-fragment-of-topic
+	      "http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata"))
+	    (frag-topic
+	     (get-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\"]}]}],\"tm-ids\":[\"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,\"tm-ids\":[\"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
+  (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
+		    (get-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))
+		(topicStubs (getf fragment-list :topicStubs))
+		(f-associations (getf fragment-list :associations)))
+	    (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")))))
+	    (is-false (getf topic :itemIdentities))
+	    (is-false (getf topic :subjectLocators))
+	    (is (= (length (getf topic :subjectIdentifiers)) 1))
+	    (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 :names)) 2))
+	    (let ((name-1 (first (getf topic :names)))
+		  (name-2 (second (getf topic :names))))
+	      (is-false (getf name-1 :itemIdentities))
+	      (is-false (getf name-1 :type))
+	      (is-false (getf name-1 :scopes))
+	      (is (string= (getf name-1 :value)
+			  "Topic Maps 2002"))
+	      (is-false (getf name-1 :variants))
+	      (is (= (length (getf name-2 :itemIdentities)) 1))
+	      (is (string= (first (getf name-2 :itemIdentities))
+			   "http://psi.egovpt.org/itemIdentifiers#t101_n2"))
+	      (is (= (length (getf name-2 :type)) 1))
+	      (is (string= (first (getf name-2 :type))
+			   "http://psi.egovpt.org/types/long-name"))
+	      (is (= (length (getf name-2 :scopes)) 1))
+	      (is (= (length (first (getf name-2 :scopes))) 1))
+	      (is (string= (first (first (getf name-2 :scopes)))
+			   "http://psi.egovpt.org/types/long-name"))
+	      (is (string= (getf name-2 :value)
+			   "ISO/IEC 13250:2002: Topic Maps"))
+	      (is (= (length (getf name-2 :variants)) 1))
+	      (let ((variant (first (getf name-2 :variants))))
+		(is (= (length (getf variant :itemIdentities)) 2))
+		(is (or (string= (first (getf variant :itemIdentities))
+				 "http://psi.egovpt.org/itemIdentifiers#t101_n2_v1")
+			(string= (first (getf variant :itemIdentities))
+				 "http://psi.egovpt.org/itemIdentifiers#t101_n2_v2")))
+		(is (or (string= (second (getf variant :itemIdentities))
+				 "http://psi.egovpt.org/itemIdentifiers#t101_n2_v1")
+			(string= (second (getf variant :itemIdentities))
+				 "http://psi.egovpt.org/itemIdentifiers#t101_n2_v2")))
+		(is (= (length (getf variant :scopes)) 2))
+		(is (= (length (first (getf variant :scopes))) 1))
+		(is (= (length (second (getf variant :scopes))) 1))
+		(is (or (string= (first (first (getf variant :scopes)))
+				 "http://www.topicmaps.org/xtm/1.0/core.xtm#sort")
+			(string= (first (first (getf variant :scopes)))
+				 "http://psi.egovpt.org/types/long-name")))
+		(is (or (string= (first (second (getf variant :scopes)))
+				 "http://www.topicmaps.org/xtm/1.0/core.xtm#sort")
+			(string= (first (second (getf variant :scopes)))
+				 "http://psi.egovpt.org/types/long-name")))
+		(is-false (getf variant :resourceRef))
+		(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))))
+	    (let ((occurrence-1 (first (getf topic :occurrences)))
+		  (occurrence-2 (second (getf topic :occurrences)))
+		  (occurrence-3 (third (getf topic :occurrences)))
+		  (occurrence-4 (fourth (getf topic :occurrences)))
+		  (ref-topic
+		   (d:identified-construct
+		    (elephant:get-instance-by-value 'd:PersistentIdC 'd:uri
+						    "http://psi.egovpt.org/status/InternationalStandard"))))
+	      (is-false (getf occurrence-1 :itemIdentities))
+	      (is (= (length (getf occurrence-1 :type)) 1))
+	      (is (string= (first (getf occurrence-1 :type))
+			   "http://psi.egovpt.org/types/standardHasStatus"))
+	      (is-false (getf occurrence-1 :scopes))
+	      (is (string= (getf occurrence-1 :resourceRef)
+			   (concatenate 'string "#" (d:topicid ref-topic))))
+	      (is-false (getf occurrence-1 :resourceData))
+	      (is-false (getf occurrence-2 :itemIdentities))
+	      (is (= (length (getf occurrence-2 :type)) 1))
+	      (is (string= (first (getf occurrence-2 :type))
+			   "http://psi.egovpt.org/types/description"))
+	      (is-false (getf occurrence-2 :scopes))
+	      (is-false (getf occurrence-2 :resourceRef))
+	      (is (string= (getf (getf occurrence-2 :resourceData) :datatype)
+			   "http://www.w3.org/2001/XMLSchema#string"))
+	      (is-true (getf (getf occurrence-2 :resourceData) :value))
+	      (is-false (getf occurrence-3 :itemIdentities))
+	      (is (= (length (getf occurrence-3 :type)) 1))
+	      (is (string= (first (getf occurrence-3 :type))
+			   "http://psi.egovpt.org/types/standardValidFromDate"))
+	      (is-false (getf occurrence-3 :scopes))
+	      (is-false (getf occurrence-3 :resourceRef))
+	      (is (string= (getf (getf occurrence-3 :resourceData) :datatype)
+			   "//www.w3.org/2001/XMLSchema#date"))
+	      (is (string= (getf (getf occurrence-3 :resourceData) :value)
+			   "2002-05-19"))
+	      (is-false (getf occurrence-4 :itemIdentities))
+	      (is (= (length (getf occurrence-4 :type)) 1))
+	      (is (string= (first (getf occurrence-4 :type))
+			   "http://psi.egovpt.org/types/links"))
+	      (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 (= (length topicStubs) 15))
+	    (loop for topicStub in topicStubs
+	       do (let ((id (getf topicStub :ID))
+			(itemIdentities (getf topicStub :itemIdentities))
+			(subjectLocators (getf topicStub :subjectLocators))
+			(subjectIdentifiers (getf topicStub :subjectIdentifiers)))
+		    (is (= (length subjectIdentifiers) 1))
+		    (let ((subjectIdentifier
+			   (first subjectIdentifiers)))
+		      (let ((topic
+			     (d:identified-construct
+			      (elephant:get-instance-by-value 'd:PersistentIdC 'd:uri
+							      subjectIdentifier))))
+			(is-true topic)
+			(is-false subjectLocators)
+			(is (string= (d:topicid topic) id))
+			(cond
+			  ((string= subjectIdentifier "http://psi.egovpt.org/types/semanticstandard")
+			   (is (= (length itemIdentities) 1))
+			   (is (string= (first itemIdentities)
+					"http://psi.egovpt.org/itemIdentifiers#t3a")))
+			  ((string= subjectIdentifier "http://www.topicmaps.org/xtm/1.0/core.xtm#sort")
+			   (is-false itemIdentities))
+			  ((string= subjectIdentifier "http://psi.egovpt.org/types/long-name")
+			   (is (= (length itemIdentities) 1))
+			   (is (string= (first itemIdentities)
+					"http://psi.egovpt.org/itemIdentifiers#t50a")))
+			  ((string= subjectIdentifier "http://psi.egovpt.org/types/standardHasStatus")
+			   (is (= (length itemIdentities) 1))
+			   (is (string= (first itemIdentities)
+					"http://psi.egovpt.org/itemIdentifiers#t51")))
+			  ((string= subjectIdentifier "http://psi.egovpt.org/types/description")
+			   (is (= (length itemIdentities) 1))
+			   (is (string= (first itemIdentities)
+					"http://psi.egovpt.org/itemIdentifiers#t53")))
+			  ((string= subjectIdentifier "http://psi.egovpt.org/types/standardValidFromDate")
+			   (is (= (length itemIdentities) 1))
+			   (is (string= (first itemIdentities)
+					"http://psi.egovpt.org/itemIdentifiers#t54")))
+			  ((string= subjectIdentifier "http://psi.egovpt.org/types/links")
+			   (is (= (length itemIdentities) 1))
+			   (is (string= (first itemIdentities)
+					"http://psi.egovpt.org/itemIdentifiers#t55")))
+			  ((string= subjectIdentifier "http://psi.egovpt.org/types/standardIsAboutSubject")
+			   (is (= (length itemIdentities) 1))
+			   (is (string= (first itemIdentities)
+					"http://psi.egovpt.org/itemIdentifiers#t60")))
+			  ((string= subjectIdentifier "http://psi.egovpt.org/types/SubjectRoleType")
+			   (is (= (length itemIdentities) 1))
+			   (is (string= (first itemIdentities)
+					"http://psi.egovpt.org/itemIdentifiers#t61")))
+			  ((string= subjectIdentifier "http://psi.egovpt.org/subject/Semantic+Description")
+			   (is-false itemIdentities))
+			  ((string= subjectIdentifier "http://psi.egovpt.org/types/serviceUsesStandard")
+			   (is (= (length itemIdentities) 1))
+			   (is (string= (first itemIdentities)
+					"http://psi.egovpt.org/itemIdentifiers#t64")))
+			  ((string= subjectIdentifier "http://psi.egovpt.org/types/ServiceRoleType")
+			   (is (= (length itemIdentities) 1))
+			   (is (string= (first itemIdentities)
+					"http://psi.egovpt.org/itemIdentifiers#t63")))
+			  ((string= subjectIdentifier "http://psi.egovpt.org/service/Norwegian+National+Curriculum")
+			   (is-false itemIdentities))
+			  ((string= subjectIdentifier "http://psi.egovpt.org/types/StandardRoleType")
+			   (is (= (length itemIdentities) 1))
+			   (is (string= (first itemIdentities)
+					"http://psi.egovpt.org/itemIdentifiers#t62")))
+			  ((string= subjectIdentifier "http://psi.egovpt.org/status/InternationalStandard")
+			   (is (= (length itemIdentities) 1))
+			   (is (string= (first itemIdentities)
+					"http://psi.egovpt.org/itemIdentifiers#t52")))
+			  (t
+			   (is-true (format t "bad subjectIdentifier found in topicStubs"))))))))
+	    (is (= (length f-associations) 2))
+	    (is (= (length (getf (first f-associations) :type)) 1))
+	    (is (= (length (getf (second f-associations) :type)) 1))
+	    (let ((association-1
+		   (if (string= (first (getf (first f-associations) :type))
+				"http://psi.egovpt.org/types/standardIsAboutSubject")
+		       (first f-associations)
+		       (second f-associations)))
+		  (association-2
+		   (if (string= (first (getf (first f-associations) :type))
+				"http://psi.egovpt.org/types/serviceUsesStandard")
+		       (first f-associations)
+		       (second f-associations))))
+	      (is-true association-1)
+	      (is-true association-2)
+	      (is-false (getf association-1 :itemIdentities))
+	      (is-false (getf association-1 :scopes))
+	      (is (= (length (getf association-1 :roles)) 2))
+	      (let ((role-1 (first (getf association-1 :roles)))
+		    (role-2 (second (getf association-1 :roles))))
+		(is-false (getf role-1 :itemIdentities))
+		(is (= (length (getf role-1 :type))))
+		(is (string= (first (getf role-1 :type))
+			     "http://psi.egovpt.org/types/StandardRoleType"))
+		(is (= (length (getf role-1 :topicRef)) 1))
+		(is (string= (first (getf role-1 :topicRef))
+			     "http://psi.egovpt.org/standard/Topic+Maps+2002"))
+		(is-false (getf role-2 :itemIdentities))
+		(is (= (length (getf role-2 :itemIdentities))))
+		(is (string= (first (getf role-2 :type))
+			     "http://psi.egovpt.org/types/SubjectRoleType"))
+		(is (= (length (getf role-2 :topicRef)) 1))
+		(is (string= (first (getf role-2 :topicRef))
+			     "http://psi.egovpt.org/subject/Semantic+Description")))
+	      (is-false (getf association-2 :itemIdentities))
+	      (is-false (getf association-2 :scopes))
+	      (is (= (length (getf association-2 :roles)) 2))
+	      (let ((role-1 (first (getf association-2 :roles)))
+		    (role-2 (second (getf association-2 :roles))))
+		(is-false (getf role-1 :itemIdentities))
+		(is (= (length (getf role-1 :type))))
+		(is (string= (first (getf role-1 :type))
+			     "http://psi.egovpt.org/types/ServiceRoleType"))
+		(is (= (length (getf role-1 :topicRef)) 1))
+		(is (string= (first (getf role-1 :topicRef))
+			     "http://psi.egovpt.org/service/Norwegian+National+Curriculum"))
+		(is-false (getf role-2 :itemIdentities))
+		(is (= (length (getf role-2 :itemIdentities))))
+		(is (string= (first (getf role-2 :type))
+			     "http://psi.egovpt.org/types/StandardRoleType"))
+		(is (= (length (getf role-2 :topicRef)) 1))
+		(is (string= (first (getf role-2 :topicRef))
+			     "http://psi.egovpt.org/standard/Topic+Maps+2002"))))))))))
+
+
+(test test-json-importer
+  (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,\"tm-ids\":[\"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\"]}]}],\"tm-ids\":[\"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
+	       (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
+		       (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
+		       (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#t55")))
+		      ((string= psi "http://psi.egovpt.org/types/standardIsAboutSubject") ;t60
+		       (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#t60")))
+		      ((string= psi "http://psi.egovpt.org/types/SubjectRoleType") ;t61
+		       (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#t61")))
+		      ((string= psi "http://psi.egovpt.org/types/StandardRoleType") ;t62
+		       (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#t62")))
+		      ((string= psi "http://psi.egovpt.org/types/ServiceRoleType") ;t63
+		       (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#t63")))
+		      ((string= psi "http://psi.egovpt.org/types/serviceUsesStandard") ;t64
+		       (is (= (length (names topic)) 1))
+		       (is (string= (charvalue (first (names topic)))
+				    "service uses standard"))
+		       (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#t64")))
+		      ((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)))
+				    "http://psi.egovpt.org/itemIdentifiers#t100"))
+		       (is (= (length (names topic)) 1))
+		       (is (string= (charvalue (first (names topic)))
+				    "ISO 19115"))
+		       (is (= (length (item-identifiers (first (names topic))))))
+		       (is (string= (uri (first (item-identifiers (first (names topic)))))
+				    "http://psi.egovpt.org/itemIdentifiers#t100_n1"))
+		       (is (= (length (variants (first (names topic)))) 2))
+		       (let ((variant-1 (first (variants (first (names topic)))))
+			     (variant-2 (second (variants (first (names topic))))))
+			 (is (= (length (item-identifiers variant-1)) 1))
+			 (is (string= (uri (first (item-identifiers variant-1)))
+				      "http://psi.egovpt.org/itemIdentifiers#t100_n1_v1"))
+			 (is (= (length (item-identifiers variant-2)) 1))
+			 (is (string= (uri (first (item-identifiers variant-2)))
+				      "http://psi.egovpt.org/itemIdentifiers#t100_n1_v2"))
+			 (is (= (length (themes variant-1)) 1))
+			 (is (string= (uri (first (psis (first (themes variant-1)))))
+				      "http://www.topicmaps.org/xtm/1.0/core.xtm#display"))
+			 (is (= (length (themes variant-2)) 1))
+			 (is (string= (uri (first (psis (first (themes variant-2)))))
+				      "http://www.topicmaps.org/xtm/1.0/core.xtm#sort"))
+			 (is (string= (charvalue variant-1)
+				      "Geographic Information - Metadata"))
+			 (is (string= (datatype variant-1)
+				      "http://www.w3.org/2001/XMLSchema#string"))
+			 (is (string= (charvalue variant-2)
+				      "ISO-19115"))
+			 (is (string= (datatype variant-2)
+				      "http://www.w3.org/2001/XMLSchema#string")))
+		       (is (= (length (occurrences topic)) 4))
+		       (let ((occ-1 (first (occurrences topic)))
+			     (occ-2 (second (occurrences topic)))
+			     (occ-3 (third (occurrences topic)))
+			     (occ-4 (fourth (occurrences topic))))
+			 (is (= (length (item-identifiers occ-1)) 1))
+			 (is (string= (uri (first (item-identifiers occ-1)))
+				      "http://psi.egovpt.org/itemIdentifiers#t100_o1"))
+			 (is (= (length (item-identifiers occ-2)) 1))
+			 (is (string= (uri (first (item-identifiers occ-2)))
+				      "http://psi.egovpt.org/itemIdentifiers#t100_o2"))
+			 (is (= (length (item-identifiers occ-3)) 1))
+			 (is (string= (uri (first (item-identifiers occ-3)))
+				      "http://psi.egovpt.org/itemIdentifiers#t100_o3"))
+			 (is (= (length (item-identifiers occ-4)) 1))
+			 (is (string= (uri (first (item-identifiers occ-4)))
+				      "http://psi.egovpt.org/itemIdentifiers#t100_o4"))
+			 (is (string= (uri (first (psis (instance-of occ-1))))
+				      "http://psi.egovpt.org/types/standardHasStatus"))
+			 (is (string= (uri (first (psis (instance-of occ-2))))
+				      "http://psi.egovpt.org/types/description"))
+			 (is (string= (uri (first (psis (instance-of occ-3))))
+				      "http://psi.egovpt.org/types/standardValidFromDate"))
+			 (is (string= (uri (first (psis (instance-of occ-4))))
+				      "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.budabe.de/"))
+			 (is (string= (datatype occ-2)
+				      "http://www.w3.org/2001/XMLSchema#string"))
+			 (is (string= (charvalue occ-2)
+				      "The ISO 19115 standard ..."))
+			 (is (string= (datatype occ-3)
+				      "http://www.w3.org/2001/XMLSchema#date"))
+			 (is (string= (charvalue occ-3)
+				      "2003-01-01"))
+			 (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
+		       (is-false (names topic))
+		       (is-false (occurrences topic))
+		       (is-false (locators topic))
+		       (is (= (length (psis topic)) 1))
+		       (is-false (item-identifiers topic)))
+		      ((string= psi "http://psi.egovpt.org/subject/GeoData") ;t203
+		       (is-false (names topic))
+		       (is-false (occurrences topic))
+		       (is-false (locators topic))
+		       (is (= (length (psis topic)) 1))
+		       (is-false (item-identifiers topic)))
+		      ((or (string= psi "http://psi.egovpt.org/service/Google+Maps") ;t301a
+			   (string= psi "http://maps.google.com"))
+		       (is-false (names topic))
+		       (is-false (occurrences topic))
+		       (is-false (locators topic))
+		       (is (= (length (psis topic)) 2))
+		       (is (or (string= (uri (first (psis topic)))
+					"http://psi.egovpt.org/service/Google+Maps")
+			       (string= (uri (first (psis topic)))
+					"http://maps.google.com")))
+		       (is (or (string= (uri (second (psis topic)))
+					"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")))))))))
+
+
+(test test-json-importer-merge
+  (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,\"tm-ids\":[\"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,\"tm-ids\":[\"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"))))))))
+
+
+      
 (defun run-json-tests()
   (tear-down-test-db)
   (run! 'json-tests))
\ No newline at end of file

Modified: trunk/src/unit_tests/versions_test.lisp
==============================================================================
--- trunk/src/unit_tests/versions_test.lisp	(original)
+++ trunk/src/unit_tests/versions_test.lisp	Mon Mar  9 18:20:10 2009
@@ -217,28 +217,31 @@
           (format t "semantic-standard: ~a~&"
                   (remove-duplicates (map 'list #'uri (mapcan #'psis (referenced-topics (first fragments-revision3))))
                                      :test #'string=))
-          ;(is-false
-          ; (set-exclusive-or 
-          ;  '("http://psi.egovpt.org/types/standard")
-          ;  (remove-duplicates (map 'list #'uri (mapcan #'psis (referenced-topics (first fragments-revision3))))
-          ;                     :test #'string=)
-          ;  :test #'string=))
+          (is-false
+           (set-exclusive-or 
+            '("http://psi.egovpt.org/types/standard")
+            (remove-duplicates (map 'list #'uri (mapcan #'psis (referenced-topics (first fragments-revision3))))
+                               :test #'string=)
+            :test #'string=))
                                         ; 0 if we ignore instanceOf associations
           (is (= 0 (length (associations (first fragments-revision3)))))
                                
           (is (string= 
                "http://psi.egovpt.org/standard/Common+Lisp"
                (uri (first (psis (topic (third fragments-revision3)))))))
-          ;(is-false
-          ; (set-exclusive-or 
-          ;  '("http://psi.egovpt.org/types/standard"
-          ;    "http://psi.egovpt.org/types/links")
-          ;  (remove-duplicates 
-          ;   (map 'list 
-          ;        #'uri 
-          ;        (mapcan #'psis (referenced-topics (third fragments-revision3))))
-          ;   :test #'string=)
-          ;  :test #'string=))
+          (is-false
+           (set-exclusive-or 
+            '("http://psi.egovpt.org/types/standard"
+              "http://psi.egovpt.org/types/links";)
+              "http://www.topicmaps.org/xtm/1.0/core.xtm#sort"
+              "http://www.topicmaps.org/xtm/1.0/core.xtm#display"
+              "http://psi.egovpt.org/types/long-name")
+            (remove-duplicates 
+             (map 'list 
+                  #'uri 
+                  (mapcan #'psis (referenced-topics (third fragments-revision3))))
+             :test #'string=)
+            :test #'string=))
                                         ;0 if we ignore instanceOf associations
           (is (= 0 (length (associations (third fragments-revision3)))))
 



From lgiessmann at common-lisp.net  Tue Mar 10 11:34:37 2009
From: lgiessmann at common-lisp.net (Lukas Giessmann)
Date: Tue, 10 Mar 2009 11:34:37 +0000
Subject: [isidorus-cvs] r16 - in trunk: docs src/json src/rest_interface
	src/unit_tests
Message-ID: <E1Lh0EH-0007th-91@common-lisp.net>

Author: lgiessmann
Date: Tue Mar 10 11:34:36 2009
New Revision: 16

Log:
added a possibilit to get all topic-psis via the rest interface as a json list of lists +ssh://lgiessmann at common-lisp.net/project/isidorus/svn

Modified:
   trunk/docs/xtm_json.txt
   trunk/src/json/json_exporter.lisp
   trunk/src/rest_interface/set-up-json-interface.lisp
   trunk/src/unit_tests/json_test.lisp

Modified: trunk/docs/xtm_json.txt
==============================================================================
--- trunk/docs/xtm_json.txt	(original)
+++ trunk/docs/xtm_json.txt	Tue Mar 10 11:34:36 2009
@@ -84,6 +84,10 @@
 // outgoing fragment have a list with more tm-ids but at least one
 
 
+a summary of all topic psis within isidorus
+[["topic-1-psi-1","topic-1-psi-2",<...>],["topic-2-psi-1","topic-2-psi-2",<...>],<...>]
+
+
 
 === example fragment with one topic, a few topicStubs and associations =========
 {

Modified: trunk/src/json/json_exporter.lisp
==============================================================================
--- trunk/src/json/json_exporter.lisp	(original)
+++ trunk/src/json/json_exporter.lisp	Tue Mar 10 11:34:36 2009
@@ -1,6 +1,7 @@
 (defpackage :json-exporter
   (:use :cl :json :datamodel)
-  (:export :to-json-string))
+  (:export :to-json-string
+	   :get-all-topic-psis))
 
 (in-package :json-exporter)
 
@@ -268,4 +269,14 @@
 							      (d:uri (first (d:item-identifiers item))) "\",")))
 			    (concatenate 'string (subseq j-tm-ids 0 (- (length j-tm-ids) 1)) "]"))
 			  "null"))))
-    (concatenate 'string "{" main-topic "," topicStubs "," associations "," tm-ids "}")))
\ No newline at end of file
+    (concatenate 'string "{" main-topic "," topicStubs "," associations "," tm-ids "}")))
+
+
+(defun get-all-topic-psis()
+  "returns all topic psis as a json list of the form
+   [[topic-1-psi-1, topic-1-psi-2],[topic-2-psi-1, topic-2-psi-2],...]"
+  (encode-json-to-string
+   (remove-if #'null (map 'list #'(lambda(psi-list)
+				    (when psi-list
+				      (map 'list #'uri psi-list)))
+			  (map 'list #'psis (elephant:get-instances-by-class 'TopicC))))))
\ No newline at end of file

Modified: trunk/src/rest_interface/set-up-json-interface.lisp
==============================================================================
--- trunk/src/rest_interface/set-up-json-interface.lisp	(original)
+++ trunk/src/rest_interface/set-up-json-interface.lisp	Tue Mar 10 11:34:36 2009
@@ -1,21 +1,30 @@
 (in-package :rest-interface)
 
-(defparameter *json-rest-prefix* "/json/psi")
-(defparameter *json-user-interface-url* "/isidorus")
-(defparameter *json-user-interface-file-path* "json/json_interface.html")
+(defparameter *json-rest-prefix* "/json/psi") ;the prefix to get a fragment by the psis -> localhost:8000/json/psi/<fragment-psi>
+(defparameter *json-rest-all-psis* "/json/psis") ;the url to get all topic psis of isidorus -> localhost:8000/json/psis
+(defparameter *json-user-interface-url* "/isidorus") ;the url to the user interface -> localhost:8000/isidorus
+(defparameter *json-user-interface-file-path* "json/json_interface.html") ;the file path to the HTML file implements the user interface
 
-(defun set-up-json-interface (&key (rest-prefix *json-rest-prefix*) (ui-url *json-user-interface-url*) (ui-file-path *json-user-interface-file-path*))
+
+(defun set-up-json-interface (&key (rest-prefix *json-rest-prefix*) (rest-all-psis *json-rest-all-psis*)
+			      (ui-url *json-user-interface-url*) (ui-file-path *json-user-interface-file-path*))
   "registers the json im/exporter to the passed base-url in hunchentoot's dispatch-table
    and also registers a file-hanlder to the html-user-interface"
   (declare (string rest-prefix ui-url ui-file-path))
   (let ((rest-regex (concatenate 'string rest-prefix "/(.+)$"))
-	(ui-regex (concatenate 'string ui-url "/?$")))
+	(ui-regex (concatenate 'string ui-url "/?$"))
+	(all-psis-regex (concatenate 'string rest-all-psis "/?$")))
     ;(format t "rest-interface: ~a~%user-interface: ~a~%user-interface-file-path: ~a~%" rest-regex ui-regex ui-file-path)
     (push
      (create-regex-dispatcher ui-regex #'(lambda()
 					 (hunchentoot:handle-static-file ui-file-path)))
      hunchentoot:*dispatch-table*)
     (push
+     (create-regex-dispatcher all-psis-regex #'(lambda()
+						 (setf (hunchentoot:content-type) "application/json") ;RFC 4627
+						 (get-all-topic-psis)))
+     hunchentoot:*dispatch-table*)
+    (push
      (create-regex-dispatcher rest-regex
 			      #'(lambda (&optional uri)
 				  (assert uri)
@@ -30,8 +39,6 @@
 							  uri)))
 					(http-method (request-method))
 					(external-format (flexi-streams:make-external-format :UTF-8 :eol-style :LF))) ;is needed to get a string of the put-request
-				    (with-open-file (stream "/home/lukas/Desktop/tmp2.txt" :direction :output :if-exists :supersede)
-				      (format stream "http-method: ~a~%" http-method))
 				    (cond
 				      ((eq http-method :GET)
 				       (progn
@@ -54,59 +61,19 @@
 					   (condition (err) (progn
 							      (setf (hunchentoot:return-code) hunchentoot:+http-internal-server-error+)
 							      (format nil "<p style=\"color:red\">Condition: \"~a\"</p>" err))))))
-				      ((eq http-method :POST)
-				       (let ((post-data (hunchentoot:raw-post-data :external-format external-format :force-text t)))
-					(with-open-file (stream "/home/lukas/Desktop/tmp.txt" :direction :output :if-exists :supersede)
-					  (format stream "post-data: ~a~%" post-data))
-					 (handler-case (progn
-							 (json-importer:json-to-elem post-data)
-							 (setf (hunchentoot:return-code) hunchentoot:+http-ok+)
-							 (setf (hunchentoot:content-type) "text")
-							 (format nil "~a" hunchentoot:+http-ok+))
-					   (condition (err) (progn
-							      (setf (hunchentoot:return-code) hunchentoot:+http-internal-server-error+)
-							      (format nil "<p style=\"color:red\">Condition: \"~a\"</p>" err))))))
-				      (t
-				       (progn ;for all htt-methods except for get and post
-					 (setf (hunchentoot:return-code) hunchentoot:+http-internal-server-error+)
-					 (format nil "<p style=\"color:red\">You have to use either the HTTP-Method \"GET\" or \"PUT\", but you used \"~a\"</p>" http-method)))))))
-     hunchentoot:*dispatch-table*)))
-
-
-
-;
-;				    (if (eq http-method :GET)
-;					(progn
-;					  (setf (hunchentoot:content-type) "application/json") ;RFC 4627
-;					  (let ((fragment
-;						 (get-latest-fragment-of-topic identifier)))
-;					    (if fragment
-;						(handler-case (to-json-string fragment)
-;						  (condition (err) (progn
-;								     (setf (hunchentoot:return-code) hunchentoot:+http-internal-server-error+)
-;								     (format nil "<p style=\"color:red\">Condition: \"~a\"</p>" err))))
-;						"{}")))
-;					(if (eq http-method :PUT)
-;					    (let ((put-data (hunchentoot:raw-post-data :external-format external-format :force-text t)))	      
-;					      (handler-case (progn
-;							      (json-importer:json-to-elem put-data)
-;							      (setf (hunchentoot:return-code) hunchentoot:+http-ok+)
-;							      (setf (hunchentoot:content-type) "text")
-;							      (format nil "~a" hunchentoot:+http-ok+))
-;						(condition (err) (progn
-;								   (setf (hunchentoot:return-code) hunchentoot:+http-internal-server-error+)
-;								   (format nil "<p style=\"color:red\">Condition: \"~a\"</p>" err)))))
-;					    (if (eq http-method :POST)
-;						(let ((post-data (hunchentoot:post-parameter "json-data")))
-;						  (handler-case (progn
-;							      (json-importer:json-to-elem post-data)
-;							      (setf (hunchentoot:return-code) hunchentoot:+http-ok+)
-;							      (setf (hunchentoot:content-type) "text")
-;							      (format nil "~a" hunchentoot:+http-ok+))
-;						    (condition (err) (progn
-;								       (setf (hunchentoot:return-code) hunchentoot:+http-internal-server-error+)
-;								       (format nil "<p style=\"color:red\">Condition: \"~a\"</p>" err)))))
-;						(progn ;for all htt-methods except for get and post
-;						  (setf (hunchentoot:return-code) hunchentoot:+http-internal-server-error+)
-;						  (format nil "<p style=\"color:red\">You have to use either the HTTP-Method \"GET\" or \"PUT\", but you used \"~a\"</p>" http-method))))))))
-;     hunchentoot:*dispatch-table*)))
\ No newline at end of file
+				      ))))
+;;				      ((eq http-method :POST)
+;;				       (let ((post-data (hunchentoot:raw-post-data :external-format external-format :force-text t)))
+;;					 (handler-case (progn
+;;							 (json-importer:json-to-elem post-data)
+;;							 (setf (hunchentoot:return-code) hunchentoot:+http-ok+)
+;;							 (setf (hunchentoot:content-type) "text")
+;;							 (format nil "~a" hunchentoot:+http-ok+))
+;;					   (condition (err) (progn
+;;							      (setf (hunchentoot:return-code) hunchentoot:+http-internal-server-error+)
+;;							      (format nil "<p style=\"color:red\">Condition: \"~a\"</p>" err))))))
+;;				      (t
+;;				       (progn ;for all htt-methods except for get and post
+;;					 (setf (hunchentoot:return-code) hunchentoot:+http-internal-server-error+)
+;;					 (format nil "<p style=\"color:red\">You have to use either the HTTP-Method \"GET\" or \"PUT\", but you used \"~a\"</p>" http-method)))))))
+     hunchentoot:*dispatch-table*)))
\ No newline at end of file

Modified: trunk/src/unit_tests/json_test.lisp
==============================================================================
--- trunk/src/unit_tests/json_test.lisp	(original)
+++ trunk/src/unit_tests/json_test.lisp	Tue Mar 10 11:34:36 2009
@@ -14,7 +14,8 @@
 	   :test-get-fragment-values-from-json-list
 	   :run-json-tests
 	   :test-json-importer
-	   :test-json-importer-merge))
+	   :test-json-importer-merge
+	   :test-get-all-topic-psis))
 
 
 (in-package :json-test)
@@ -929,7 +930,126 @@
 			 "http://psi.egovpt.org/standard/Common+Lisp"))))))))
 
 
-      
+(test test-get-all-topic-psis
+  (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-psis (json:decode-json-from-string (get-all-topic-psis))))
+	(is (= (length json-psis) (length (elephant:get-instances-by-class 'd:TopicC))))
+	(loop for topic-psis in json-psis
+	   do (cond
+		((string= (first topic-psis) "http://www.topicmaps.org/xtm/1.0/core.xtm#topic")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://www.topicmaps.org/xtm/1.0/core.xtm#association")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://www.topicmaps.org/xtm/1.0/core.xtm#occurrence")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://www.topicmaps.org/xtm/1.0/core.xtm#class-instance")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://www.topicmaps.org/xtm/1.0/core.xtm#class")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://www.topicmaps.org/xtm/1.0/core.xtm#superclass-subclass")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://www.topicmaps.org/xtm/1.0/core.xtm#superclass")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://www.topicmaps.org/xtm/1.0/core.xtm#subclass")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://www.topicmaps.org/xtm/1.0/core.xtm#sort")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://www.topicmaps.org/xtm/1.0/core.xtm#display")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://psi.topicmaps.org/iso13250/model/type-instance")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://psi.topicmaps.org/iso13250/model/type")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://psi.topicmaps.org/iso13250/model/instance")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://www.networkedplanet.com/psi/npcl/meta-types/topic-type")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://psi.egovpt.org/types/service")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://psi.egovpt.org/types/standard")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://psi.egovpt.org/types/semanticstandard")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://psi.egovpt.org/types/technicalstandard")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://psi.egovpt.org/types/subject")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://www.networkedplanet.com/psi/npcl/meta-types/occurrence-type")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://www.networkedplanet.com/psi/npcl/meta-types/association-type")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://www.networkedplanet.com/psi/npcl/meta-types/association-role-type")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://psi.egovpt.org/types/topicInTaxonomy")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://psi.egovpt.org/types/long-name")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://psi.egovpt.org/types/standardHasStatus")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://psi.egovpt.org/status/InternationalStandard")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://psi.egovpt.org/types/description")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://psi.egovpt.org/types/standardValidFromDate")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://psi.egovpt.org/types/links")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://psi.egovpt.org/types/topicIsAboutSubject")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://psi.egovpt.org/types/isNarrowerSubject")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://psi.egovpt.org/types/narrowerSubject")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://psi.egovpt.org/types/broaderSubject")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://psi.egovpt.org/types/standardIsAboutSubject")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://psi.egovpt.org/types/SubjectRoleType")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://psi.egovpt.org/types/StandardRoleType")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://psi.egovpt.org/types/ServiceRoleType")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://psi.egovpt.org/types/serviceUsesStandard")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://psi.egovpt.org/standard/Topic+Maps+2002")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://psi.egovpt.org/subject/Web+Services")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://psi.egovpt.org/subject/Semantic+Description")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://psi.egovpt.org/subject/Data")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://psi.egovpt.org/subject/GeoData")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://psi.egovpt.org/subject/Legal+Data")
+		 (is (= (length topic-psis) 1)))
+		((string= (first topic-psis) "http://psi.egovpt.org/service/Norwegian+National+Curriculum")
+		 (is (= (length topic-psis) 1)))
+		((or (string= (first topic-psis) "http://psi.egovpt.org/service/Google+Maps")
+		     (string= (first topic-psis) "http://maps.google.com")
+		     (is (= (length topic-psis) 2))
+		     (is (or (string= (second topic-psis) "http://psi.egovpt.org/service/Google+Maps")
+			     (string= (second topic-psis) "http://maps.google.com")))))
+		(t
+		 (is-true (format t "found bad topic-psis: ~a" topic-psis)))))))))
+
+
 (defun run-json-tests()
   (tear-down-test-db)
-  (run! 'json-tests))
\ No newline at end of file
+  ;(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-to-json-string-associations)
+  (it.bese.fiveam:run! 'test-to-json-string-fragments)
+  (it.bese.fiveam:run! 'test-to-json-string-topics)
+  (it.bese.fiveam:run! 'test-get-all-topic-psis))



From lgiessmann at common-lisp.net  Tue Mar 17 10:49:56 2009
From: lgiessmann at common-lisp.net (Lukas Giessmann)
Date: Tue, 17 Mar 2009 10:49:56 +0000
Subject: [isidorus-cvs] r17 - in trunk/src: . json rest_interface threading
Message-ID: <E1LjWrs-0001mr-GI@common-lisp.net>

Author: lgiessmann
Date: Tue Mar 17 10:49:55 2009
New Revision: 17

Log:
changed the hunchentoot version from 0.15.7 to 1.0.0 and all depending code-fragments using the hunchentoot interface; further the json interface was modified and better structured; the little example of prototype was also modiefied, so you can get all psis of isidorus, you can get all fragments and you can commit fragments+ssh://lgiessmann at common-lisp.net/project/isidorus/svn

Modified:
   trunk/src/isidorus.asd
   trunk/src/json/json_interface.html
   trunk/src/rest_interface/publish_feeds.lisp
   trunk/src/rest_interface/rest-interface.lisp
   trunk/src/rest_interface/set-up-json-interface.lisp
   trunk/src/threading/reader-writer.lisp

Modified: trunk/src/isidorus.asd
==============================================================================
--- trunk/src/isidorus.asd	(original)
+++ trunk/src/isidorus.asd	Tue Mar 17 10:49:55 2009
@@ -121,8 +121,9 @@
 				     (:file "json_importer")