Author: lgiessmann Date: Mon Sep 5 08:57:30 2011 New Revision: 832 Log: gdl-frontend: added additional functionality to the rest-interface that serves the gdl-frontend; fixed a bug with the fragment cache Modified: branches/gdl-frontend/src/isidorus.asd branches/gdl-frontend/src/rest_interface/rest-interface.lisp branches/gdl-frontend/src/rest_interface/set-up-gdl-interface.lisp branches/gdl-frontend/src/rest_interface/set-up-json-interface.lisp Modified: branches/gdl-frontend/src/isidorus.asd ============================================================================== --- branches/gdl-frontend/src/isidorus.asd Mon Sep 5 08:16:36 2011 (r831) +++ branches/gdl-frontend/src/isidorus.asd Mon Sep 5 08:57:30 2011 (r832) @@ -112,7 +112,8 @@ (:file "set-up-json-interface" :depends-on ("rest-interface")) (:file "set-up-gdl-interface" - :depends-on ("rest-interface")) + :depends-on ("rest-interface" + "set-up-json-interface")) (:file "read" :depends-on ("rest-interface"))) :depends-on ("model" "atom" "xml" "TM-SPARQL" Modified: branches/gdl-frontend/src/rest_interface/rest-interface.lisp ============================================================================== --- branches/gdl-frontend/src/rest_interface/rest-interface.lisp Mon Sep 5 08:16:36 2011 (r831) +++ branches/gdl-frontend/src/rest_interface/rest-interface.lisp Mon Sep 5 08:57:30 2011 (r832) @@ -30,8 +30,11 @@ :read-fragment-feed :start-json-engine :start-atom-engine + :start-gdl-engine :shutdown-json-engine :shutdown-atom-engine + :set-up-json-interface + :set-up-gdl-interface :*json-get-prefix* :*get-rdf-prefix* :*json-commit-url* Modified: branches/gdl-frontend/src/rest_interface/set-up-gdl-interface.lisp ============================================================================== --- branches/gdl-frontend/src/rest_interface/set-up-gdl-interface.lisp Mon Sep 5 08:16:36 2011 (r831) +++ branches/gdl-frontend/src/rest_interface/set-up-gdl-interface.lisp Mon Sep 5 08:57:30 2011 (r832) @@ -24,6 +24,11 @@ (host-address *host-address*)) (declare (String get-fragment get-schema commit-fragment delete-fragment host-address)) + + (init-cache nil) + (format t "~%") + (init-fragments nil) + ;; 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 Modified: branches/gdl-frontend/src/rest_interface/set-up-json-interface.lisp ============================================================================== --- branches/gdl-frontend/src/rest_interface/set-up-json-interface.lisp Mon Sep 5 08:16:36 2011 (r831) +++ branches/gdl-frontend/src/rest_interface/set-up-json-interface.lisp Mon Sep 5 08:57:30 2011 (r832) @@ -15,6 +15,12 @@ (defparameter *instance-table* nil "Cointains integer==OIDs that represent a topic instance of a valid instance-topic") +(defparameter *cache-initialised* nil "determines wheter the cache has been + already set or not") + +(defparameter *fragments-initialised* nil "determines wheter the fragments has + been already initialised or not.") + ;the prefix to get a fragment by the psi -> localhost:8000/json/get/<fragment-psi> (defparameter *json-get-prefix* "/json/get/(.+)$") ;the prefix to get a fragment by the psi -> localhost:8000/json/rdf/get/<fragment-psi> @@ -88,9 +94,9 @@ and also registers a file-hanlder to the html-user-interface" ;initializes cache and fragments - (init-cache) + (init-cache nil) (format t "~%") - (init-fragments) + (init-fragments nil) ;; 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, @@ -543,19 +549,22 @@ files-and-urls))) -(defun init-cache() +(defun init-cache(force-init) "Initializes the type and instance cache-tables with all valid types/instances" - (with-writer-lock - (setf *type-table* nil) - (setf *instance-table* nil) - (let ((topictype (get-item-by-psi json-tmcl-constants::*topictype-psi* - :revision 0)) - (topictype-constraint (json-tmcl::is-type-constrained :revision 0))) - (format t "~%initializing cache: ") - (map 'list #'(lambda(top) - (format t ".") - (push-to-cache top topictype topictype-constraint)) - (elephant:get-instances-by-class 'TopicC))))) + (declare (Boolean force-init)) + (when (or force-init (not *cache-initialised*)) + (with-writer-lock + (setf *type-table* nil) + (setf *instance-table* nil) + (let ((topictype (get-item-by-psi json-tmcl-constants::*topictype-psi* + :revision 0)) + (topictype-constraint (json-tmcl::is-type-constrained :revision 0))) + (format t "~%initializing cache: ") + (map 'list #'(lambda(top) + (format t ".") + (push-to-cache top topictype topictype-constraint)) + (elephant:get-instances-by-class 'TopicC)))) + (setf *cache-initialised* t))) (defun push-to-cache (topic-instance &optional @@ -577,12 +586,15 @@ (condition () nil))) -(defun init-fragments () +(defun init-fragments (force-init) "Creates fragments of all topics that have a PSI." - (format t "creating fragments: ") - (map 'list #'(lambda(top) - (let ((psis-of-top (psis top))) - (when psis-of-top - (format t ".") - (create-latest-fragment-of-topic (uri (first psis-of-top)))))) - (elephant:get-instances-by-class 'd:TopicC))) \ No newline at end of file + (declare (Boolean force-init)) + (when (or force-init (not *fragments-initialised*)) + (format t "creating fragments: ") + (map 'list #'(lambda(top) + (let ((psis-of-top (psis top))) + (when psis-of-top + (format t ".") + (create-latest-fragment-of-topic (uri (first psis-of-top)))))) + (elephant:get-instances-by-class 'd:TopicC)) + (setf *fragments-initialised* t))) \ No newline at end of file