[isidorus-cvs] r647 - in trunk: playground src/rest_interface

[lgiessmann at common-lisp.net]

Author: lgiessmann
Date: Tue Jul 19 08:13:35 2011
New Revision: 647

Log:
trunk: changed the RESTful shutdown handler => when the server is started the function (rest-interface:die-when.finished) has to be invoked. It will end and quit the sbcl interpreter when the RESTful handler is invoked, by an http client

Added:
   trunk/playground/startIsidorus.lisp
Modified:
   trunk/src/rest_interface/admin-interface.lisp
   trunk/src/rest_interface/rest-interface.lisp

Added: trunk/playground/startIsidorus.lisp
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ trunk/playground/startIsidorus.lisp	Tue Jul 19 08:13:35 2011	(r647)
@@ -0,0 +1,8 @@
+;; this file must be called with sblc --load <this-file>
+
+(setf sb-impl::*default-external-format* :utf-8)
+(asdf:operate 'asdf:load-op 'isidorus)
+(rest-interface:start-json-engine "data_base")
+(rest-interface:start-admin-server)
+(rest-interface:die-when-finished)
+

Modified: trunk/src/rest_interface/admin-interface.lisp
==============================================================================
--- trunk/src/rest_interface/admin-interface.lisp	Tue Jul 19 05:52:35 2011	(r646)
+++ trunk/src/rest_interface/admin-interface.lisp	Tue Jul 19 08:13:35 2011	(r647)
@@ -16,6 +16,8 @@
 (defparameter *admin-shutdown* "/admin/shutdown")
 
 
+(defparameter *ready-to-die* nil)
+
 (defun set-up-admin-interface ()
   (push
    (create-regex-dispatcher *admin-local-backup* #'admin-local-backup)
@@ -41,7 +43,8 @@
 	    (shutdown-json-engine)
 	    (shutdown-atom-engine)
 	    (shutdown-admin-server)
-	    (close-tm-store)) ;in case the json and atom services are not running
+	    (close-tm-store) ;in case the json and atom services are not running
+	    (setf *ready-to-die* t))
 	  (setf (hunchentoot:return-code*) hunchentoot:+http-forbidden+))
     (condition (err)
       (progn
@@ -88,4 +91,12 @@
    (write-to-string (nth-value 5 (decode-universal-time universal-time))) ":"
    (write-to-string (nth-value 2 (decode-universal-time universal-time))) ":"
    (write-to-string (nth-value 1 (decode-universal-time universal-time))) ":"
-   (write-to-string (nth-value 0 (decode-universal-time universal-time)))))
\ No newline at end of file
+   (write-to-string (nth-value 0 (decode-universal-time universal-time)))))
+
+
+
+(defun die-when-finished()
+  (do () (rest-interface:*ready-to-die*)
+    (format t "*ready-to-die*: ~a~%" rest-interface:*ready-to-die*)
+    (sleep 1))
+  (sb-ext:quit))
\ No newline at end of file

Modified: trunk/src/rest_interface/rest-interface.lisp
==============================================================================
--- trunk/src/rest_interface/rest-interface.lisp	Tue Jul 19 05:52:35 2011	(r646)
+++ trunk/src/rest_interface/rest-interface.lisp	Tue Jul 19 08:13:35 2011	(r647)
@@ -56,11 +56,14 @@
 	   :*ajax-javascript-directory-path*
 	   :*ajax-javascript-url-prefix*
 	   :*xtm-commit-prefix*
+	   :*ready-to-die*
+	   :die-when-finished
 	   :*sparql-url*))
 
 
 (in-package :rest-interface)
 
+
 (defun create-regex-dispatcher (regex page-function)
   "Just like hunchentoot:create-regex-dispatcher except it extracts the matched values
    and passes them onto PAGE-FUNCTION as arguments. 
@@ -159,4 +162,4 @@
   (when *atom-server-acceptor*
     (hunchentoot:stop *atom-server-acceptor*))
   (setf *atom-server-acceptor* nil)
-  (close-tm-store))
\ No newline at end of file
+  (close-tm-store))