[isidorus-cvs] r308 - in branches/new-datamodel/src: ajax/javascripts rest_interface

[Lukas Giessmann]

Author: lgiessmann
Date: Fri Jul 16 05:07:51 2010
New Revision: 308

Log:
new-datamodel: adapted the start-tm-engine to the new datamodel, all fragmentsa are created when the engine starts; set the defualt timeout of all ajax-requests to 20 seconds

Modified:
   branches/new-datamodel/src/ajax/javascripts/constants.js
   branches/new-datamodel/src/rest_interface/rest-interface.lisp
   branches/new-datamodel/src/rest_interface/set-up-json-interface.lisp

Modified: branches/new-datamodel/src/ajax/javascripts/constants.js
==============================================================================
--- branches/new-datamodel/src/ajax/javascripts/constants.js	(original)
+++ branches/new-datamodel/src/ajax/javascripts/constants.js	Fri Jul 16 05:07:51 2010
@@ -23,7 +23,7 @@
 var OWN_URL = HOST_PREF + "isidorus";
 var SUMMARY_URL = HOST_PREF + "json/summary"
 var TM_OVERVIEW = "/json/tmcl/overview/";
-var TIMEOUT = 10000; // const TIMEOUT = 10000 --> "const" doesn't work under IE
+var TIMEOUT = 20000; // const TIMEOUT = 10000 --> "const" doesn't work under IE
 
 
 

Modified: branches/new-datamodel/src/rest_interface/rest-interface.lisp
==============================================================================
--- branches/new-datamodel/src/rest_interface/rest-interface.lisp	(original)
+++ branches/new-datamodel/src/rest_interface/rest-interface.lisp	Fri Jul 16 05:07:51 2010
@@ -62,7 +62,8 @@
 (defvar *server-acceptor* nil)
 
 
-(defun start-tm-engine (repository-path &key (conffile "atom/conf.lisp") (host-name "localhost") (port 8000))
+(defun start-tm-engine (repository-path &key (conffile "atom/conf.lisp")
+			(host-name "localhost") (port 8000))
   "Start the Topic Map Engine on a given port, assuming a given
    hostname. Use the repository under repository-path"
   (when *server-acceptor*
@@ -80,6 +81,11 @@
   (setf *server-acceptor* (make-instance 'hunchentoot:acceptor :address host-name :port port))
   (setf hunchentoot:*lisp-errors-log-level* :info)
   (setf hunchentoot:*message-log-pathname* "./hunchentoot-errors.log")
+  (map 'list #'(lambda(top)
+		 (let ((psis-of-top (psis top)))
+		   (when psis-of-top
+		     (create-latest-fragment-of-topic (uri (first psis-of-top))))))
+       (elephant:get-instances-by-class 'd:TopicC))
   (hunchentoot:start *server-acceptor*))
 
 (defun shutdown-tm-engine ()

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	Fri Jul 16 05:07:51 2010
@@ -180,8 +180,11 @@
   (let ((http-method (hunchentoot:request-method*)))
     (if (or (eq http-method :POST)
 	    (eq http-method :PUT))
-	(let ((external-format (flexi-streams:make-external-format :UTF-8 :eol-style :LF)))
-	  (let ((json-data (hunchentoot:raw-post-data :external-format external-format :force-text t)))
+	(let ((external-format
+	       (flexi-streams:make-external-format :UTF-8 :eol-style :LF)))
+	  (let ((json-data
+		 (hunchentoot:raw-post-data :external-format external-format
+					    :force-text t)))
 	    (handler-case
 		(let ((psis
 		       (json:decode-json-from-string json-data)))
@@ -360,18 +363,22 @@
    concatenated of the url-prefix and the relative path of all all files in the
    passed directory and its subdirectories"
   (let ((start-position-of-relative-path
-	 (- (length (write-to-string (com.gigamonkeys.pathnames:file-exists-p path-to-files-directory))) 2)))
+	 (- (length (write-to-string (com.gigamonkeys.pathnames:file-exists-p
+				      path-to-files-directory))) 2)))
     (let ((files-and-urls nil))
-      (com.gigamonkeys.pathnames:walk-directory path-to-files-directory
-						#'(lambda(current-path)
-						    (let ((current-path-string
-							   (write-to-string current-path)))
-						      (let ((last-position-of-current-path
-							     (- (length current-path-string) 1)))
-							(let ((current-url
-							       (concatenate 'string url-prefix
-									    (subseq current-path-string start-position-of-relative-path last-position-of-current-path))))
-							  (push (list :path current-path :url current-url) files-and-urls))))))
+      (com.gigamonkeys.pathnames:walk-directory
+       path-to-files-directory
+       #'(lambda(current-path)
+	   (let ((current-path-string
+		  (write-to-string current-path)))
+	     (let ((last-position-of-current-path
+		    (- (length current-path-string) 1)))
+	       (let ((current-url
+		      (concatenate
+		       'string url-prefix
+		       (subseq current-path-string start-position-of-relative-path
+			       last-position-of-current-path))))
+		 (push (list :path current-path :url current-url) files-and-urls))))))
       files-and-urls)))