[isidorus-cvs] r208 - branches/new-datamodel/src/rest_interface trunk/src/rest_interface

[Lukas Giessmann]

Author: lgiessmann
Date: Thu Feb 25 15:45:39 2010
New Revision: 208

Log:
rest-interface: fixed a bug in the restful-handler return-overview that caused a memory-leak

Modified:
   branches/new-datamodel/src/rest_interface/set-up-json-interface.lisp
   trunk/src/rest_interface/set-up-json-interface.lisp

Modified: branches/new-datamodel/src/rest_interface/set-up-json-interface.lisp
==============================================================================
--- branches/new-datamodel/src/rest_interface/set-up-json-interface.lisp	(original)
+++ branches/new-datamodel/src/rest_interface/set-up-json-interface.lisp	Thu Feb 25 15:45:39 2010
@@ -331,15 +331,15 @@
 (defun return-overview (&optional param)
   "Returns a json-object representing a topic map overview as a tree(s)"
   (declare (ignorable param))
-  (handler-case (let ((json-string
-		       (with-reader-lock
-			 (json-tmcl::tree-view-to-json-string (json-tmcl::make-tree-view)))))
-		  (setf (hunchentoot:content-type*) "application/json") ;RFC 4627
-		  json-string)
-    (Condition (err) (progn
-		       (setf (hunchentoot:return-code*) hunchentoot:+http-internal-server-error+)
-		       (setf (hunchentoot:content-type*) "text")
-		       (format nil "Condition: \"~a\"" err)))))
+  (with-reader-lock
+      (handler-case (let ((json-string
+			   (json-tmcl::tree-view-to-json-string (json-tmcl::make-tree-view))))
+		      (setf (hunchentoot:content-type*) "application/json") ;RFC 4627
+		      json-string)
+	(Condition (err) (progn
+			   (setf (hunchentoot:return-code*) hunchentoot:+http-internal-server-error+)
+			   (setf (hunchentoot:content-type*) "text")
+			   (format nil "Condition: \"~a\"" err))))))
 
 
 ;; =============================================================================
@@ -385,4 +385,4 @@
 		   (setf ret-str (concatenate 'string ret-str (subseq str idx (1+ idx))))
 		   (incf idx)))
 	     (unless (< idx (length str))
-	       (return ret-str)))))))
\ No newline at end of file
+	       (return ret-str)))))))

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	Thu Feb 25 15:45:39 2010
@@ -331,15 +331,15 @@
 (defun return-overview (&optional param)
   "Returns a json-object representing a topic map overview as a tree(s)"
   (declare (ignorable param))
-  (handler-case (let ((json-string
-		       (with-reader-lock
-			 (json-tmcl::tree-view-to-json-string (json-tmcl::make-tree-view)))))
-		  (setf (hunchentoot:content-type*) "application/json") ;RFC 4627
-		  json-string)
-    (Condition (err) (progn
-		       (setf (hunchentoot:return-code*) hunchentoot:+http-internal-server-error+)
-		       (setf (hunchentoot:content-type*) "text")
-		       (format nil "Condition: \"~a\"" err)))))
+  (with-reader-lock
+    (handler-case (let ((json-string
+			 (json-tmcl::tree-view-to-json-string (json-tmcl::make-tree-view))))
+		    (setf (hunchentoot:content-type*) "application/json") ;RFC 4627
+		    json-string)
+      (Condition (err) (progn
+			 (setf (hunchentoot:return-code*) hunchentoot:+http-internal-server-error+)
+			 (setf (hunchentoot:content-type*) "text")
+			 (format nil "Condition: \"~a\"" err))))))
 
 
 ;; =============================================================================