[isidorus-cvs] r27 - in trunk/src: ajax ajax/javascripts json rest_interface unit_tests

Lukas Giessmann lgiessmann at common-lisp.net
Mon Apr 13 17:17:57 UTC 2009


Author: lgiessmann
Date: Mon Apr 13 13:17:57 2009
New Revision: 27

Log:
fixed some problems in the ajax and in the json interface; changed the json/ajax error handling of the server, so there will be sent the condition's content as error message to the client - therefor every json-handler has a case-handler

Modified:
   trunk/src/ajax/isidorus.html
   trunk/src/ajax/javascripts/make_fragment_node.js
   trunk/src/json/json_exporter.lisp
   trunk/src/rest_interface/set-up-json-interface.lisp
   trunk/src/unit_tests/json_test.lisp

Modified: trunk/src/ajax/isidorus.html
==============================================================================
--- trunk/src/ajax/isidorus.html	(original)
+++ trunk/src/ajax/isidorus.html	Mon Apr 13 13:17:57 2009
@@ -19,10 +19,25 @@
     <!-- includes all necessary css-files -->
     <link rel="stylesheet" type="text/css" href="css/main.css"/>
     <link rel="stylesheet" type="text/css" href="css/home.css"/>
-    <link rel="stylesheet" type="text/css" href="css/search_topics.css"/>
-    <link rel="stylesheet" type="text/css" href="css/edit_topics.css"/>
-    <link rel="stylesheet" type="text/css" href="css/create_topics.css"/>
     <link rel="stylesheet" type="text/css" href="css/navi.css"/>
+
+    <!-- error handling for javascript code -->
+    <script language="JavaScript" type="text/javascript"> <!--
+    var __DEBUG__ = true;
+	
+    function onError(message, url, line)
+    {
+	window.alert("onError in \"" + url + "\" at line: "  + line + "\n" + message);
+	return true;
+    }
+
+    if(__DEBUG__ === true){
+	window.onerror = onError;
+    }
+
+    // -->
+    </script>
+
     
     <!-- includes the prototype and scriptaculous frameworks -->
     <script language="JavaScript" type="text/javascript" src="javascripts/external/prototype/prototype.js"></script>

Modified: trunk/src/ajax/javascripts/make_fragment_node.js
==============================================================================
--- trunk/src/ajax/javascripts/make_fragment_node.js	(original)
+++ trunk/src/ajax/javascripts/make_fragment_node.js	Mon Apr 13 13:17:57 2009
@@ -1040,7 +1040,13 @@
 		}
 
 		var ioElems =  topicFrame.getElementsByClassName(CLASSES.instanceOfFrame())[0].getElementsByClassName(CLASSES.textRow());
-		var _instanceOfs = "\"instanceOfs\":" + makeList(ioElems);
+		var _instanceOfs = makeList(ioElems);
+		if(_instanceOfs === "null"){
+		    _instanceOfs = "\"instanceOfs\":null";   
+		}
+		else {
+		    _instanceOfs = "\"instanceOfs\":[" + _instanceOfs + "]";
+		}
 		
 		var naElems = topicFrame.getElementsByClassName(CLASSES.namesFrame())[0].getElementsByClassName(CLASSES.nameFrame());
 		var _names = "\"names\":";
@@ -1239,7 +1245,7 @@
 				 method: "post",
 				 requestHeaders:{ "Content-Type":"application/json"},
 				 onSuccess: function(xhr){ window.alert("Fragment committed successfully!"); },
-				 onFailure: function(xhr){ window.alert("Something went wrong ...\n" + xhr.status + ": " + xhr.statusText); },
+				 onFailure: function(xhr){ window.alert("Something went wrong ...\n" + xhr.status + ": " + xhr.statusText + "\n" + xhr.responseText); },
 				 postBody: _fragment
 	                     });
 	}
@@ -1271,7 +1277,7 @@
 	    $("content").insert(makeFragmentNode(jsonFragment), {"position" : "content"});
 	}
 	catch(err){
-	    alert("Got bad json data from " + GET_PREFIX + topicPsi.gsub("#", "%23"));
+	    alert("Got bad json data from " + GET_PREFIX + topicPsi.gsub("#", "%23") + "\n" + err);
 	}
     }
 

Modified: trunk/src/json/json_exporter.lisp
==============================================================================
--- trunk/src/json/json_exporter.lisp	(original)
+++ trunk/src/json/json_exporter.lisp	Mon Apr 13 13:17:57 2009
@@ -147,7 +147,7 @@
 (defmethod to-json-string ((instance TopicC) &key (xtm-id d:*current-xtm*))
   "transforms an TopicC object to a json string"
   (let ((id
-	 (concatenate 'string "\"id\":\"" (topicid instance) "\""))
+	 (concatenate 'string "\"id\":" (json:encode-json-to-string (topicid instance))))
 	(itemIdentity
 	 (concatenate 'string "\"itemIdentities\":"
 		      (identifiers-to-json-string instance :what 'item-identifiers)))
@@ -188,7 +188,7 @@
    subjectIdentifiers"
   (when topic
     (let ((id
-	   (concatenate 'string "\"id\":\"" (topicid topic) "\""))
+	   (concatenate 'string "\"id\":" (json:encode-json-to-string (topicid topic))))
 	  (itemIdentity
 	   (concatenate 'string "\"itemIdentities\":"
 			(identifiers-to-json-string topic :what 'item-identifiers)))
@@ -227,8 +227,7 @@
 	(type
 	 (type-to-json-string instance))
 	(scope
-	 (let ((scopes (map 'list #'topicid (themes instance))))
-	   (concatenate 'string "\"scopes\":" (json:encode-json-to-string scopes))))
+	 (concatenate 'string "\"scopes\":" (ref-topics-to-json-string (themes instance))))
 	(role
 	 (concatenate 'string "\"roles\":"
 		      (if (roles instance)
@@ -280,8 +279,10 @@
 		      (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))) "\",")))
+			       ;do (setf j-tm-ids (concatenate 'string j-tm-ids "\""
+				;			      (d:uri (first (d:item-identifiers item))) "\",")))
+			       do (setf j-tm-ids (concatenate 'string j-tm-ids 
+							      (json:encode-json-to-string (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 "}")))

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	Mon Apr 13 13:17:57 2009
@@ -33,6 +33,12 @@
 			      (ajax-javascripts-url-prefix *ajax-javascript-url-prefix*))
   "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"
+
+  ;; registers the http-code 500 for an internal server error to the standard
+  ;; return codes. so there won't be attached a hunchentoot default message,
+  ;; this is necessary to be able to send error messages in an individual way/syntax
+  ;; e.g. a json error-message.
+  (push hunchentoot:+http-internal-server-error+ hunchentoot:*approved-return-codes*)
   ;; === html and css files ====================================================
   (push
    (create-regex-dispatcher ajax-user-interface-url
@@ -83,7 +89,11 @@
     (if (eq http-method :GET)
 	(progn
 	  (setf (hunchentoot:content-type*) "application/json") ;RFC 4627
-	  (get-all-topic-psis))
+	  (handler-case (get-all-topic-psis)
+	    (condition (err) (progn
+			       (setf (hunchentoot:return-code*) hunchentoot:+http-internal-server-error+)
+			       (setf (hunchentoot:content-type*) "text")
+			       (format nil "Condition: \"~a\"" err)))))
 	(setf (hunchentoot:return-code*) hunchentoot:+http-bad-request+))))
 
 
@@ -108,7 +118,8 @@
 		  (condition (err)
 		    (progn
 		      (setf (hunchentoot:return-code*) hunchentoot:+http-internal-server-error+)
-		      (format nil "<p>Condition: \"~a\"</p>" err))))
+		      (setf (hunchentoot:content-type*) "text")
+		      (format nil "Condition: \"~a\"" err))))
 		"{}")))
 	(setf (hunchentoot:return-code*) hunchentoot:+http-bad-request+))))
 
@@ -125,7 +136,8 @@
 	      (condition (err)
 		(progn
 		  (setf (hunchentoot:return-code*) hunchentoot:+http-internal-server-error+)
-		  (format nil "<p>Condition: \"~a\"</p>" err))))))
+		  (setf (hunchentoot:content-type*) "text")
+		  (format nil "Condition: \"~a\"" err))))))
 	(setf (hunchentoot:return-code*) hunchentoot:+http-bad-request+))))
 
 
@@ -138,32 +150,35 @@
 	(end-idx
 	 (handler-case (parse-integer (hunchentoot:get-parameter "end"))
 	   (condition () nil))))
-
-    (let ((topics (elephant:get-instances-by-class 'd:TopicC)))
-      (let ((end
-	     (cond
-	       ((not end-idx)
-		(length topics))
-	       ((> end-idx (length topics))
-		(length topics))
-	       ((< end-idx 0)
-		0)
-	       (t
-		end-idx))))
-	(let ((start
-	       (cond
-		 ((> start-idx (length topics))
-		  end)
-		 ((< start-idx 0)
-		  0)
-		 (t
-		  start-idx))))
-	  (let ((topics-in-range
-		 (if (<= start end)
-		     (subseq topics start end)
-		     (reverse (subseq topics end start)))))
-	    (setf (hunchentoot:content-type*) "application/json") ;RFC 4627
-	    (json-exporter:make-topic-summary topics-in-range)))))))
+    (handler-case (let ((topics (elephant:get-instances-by-class 'd:TopicC)))
+		    (let ((end
+			   (cond
+			     ((not end-idx)
+			      (length topics))
+			     ((> end-idx (length topics))
+			      (length topics))
+			     ((< end-idx 0)
+			      0)
+			     (t
+			      end-idx))))
+		      (let ((start
+			     (cond
+			       ((> start-idx (length topics))
+				end)
+			       ((< start-idx 0)
+				0)
+			       (t
+				start-idx))))
+			(let ((topics-in-range
+			       (if (<= start end)
+				   (subseq topics start end)
+				   (reverse (subseq topics end start)))))
+			  (setf (hunchentoot:content-type*) "application/json") ;RFC 4627
+			  (json-exporter:make-topic-summary topics-in-range)))))
+      (condition (err) (progn
+			 (setf (hunchentoot:return-code*) hunchentoot:+http-internal-server-error+)
+			 (setf (hunchentoot:content-type*) "text")
+			 (format nil "Condition: \"~a\"" err))))))
 
 
 ;; =============================================================================

Modified: trunk/src/unit_tests/json_test.lisp
==============================================================================
--- trunk/src/unit_tests/json_test.lisp	(original)
+++ trunk/src/unit_tests/json_test.lisp	Mon Apr 13 13:17:57 2009
@@ -116,7 +116,7 @@
 	  (elephant:add-association association-7 'themes t62)
 	  (let ((association-7-string (to-json-string association-7))
 		(json-string
-		 (concatenate 'string "{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#assoc_7\"],\"type\":null,\"scopes\":[\"" (topicid t62) "\",\"" (topicid t64) "\"],\"roles\":null}")))
+		 (concatenate 'string "{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#assoc_7\"],\"type\":null,\"scopes\":[[\"http://psi.egovpt.org/types/StandardRoleType\"],[\"http://psi.egovpt.org/types/serviceUsesStandard\"]],\"roles\":null}")))
 	    (is (string= association-7-string json-string))))))))
 
 




More information about the Isidorus-cvs mailing list