[isidorus-cvs] r832 - in branches/gdl-frontend/src: . rest_interface
lgiessmann at common-lisp.net
lgiessmann at common-lisp.net
Mon Sep 5 15:57:30 UTC 2011
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
More information about the Isidorus-cvs
mailing list