[isidorus-cvs] r331 - in trunk/src: json rest_interface
Lukas Giessmann
lgiessmann at common-lisp.net
Thu Oct 21 09:36:59 UTC 2010
Author: lgiessmann
Date: Thu Oct 21 05:36:58 2010
New Revision: 331
Log:
fixed ticket #73 -> implented caching for topictypes and topic instances
Modified:
trunk/src/json/json_delete_interface.lisp
trunk/src/rest_interface/rest-interface.lisp
trunk/src/rest_interface/set-up-json-interface.lisp
Modified: trunk/src/json/json_delete_interface.lisp
==============================================================================
--- trunk/src/json/json_delete_interface.lisp (original)
+++ trunk/src/json/json_delete_interface.lisp Thu Oct 21 05:36:58 2010
@@ -83,7 +83,7 @@
return role)))
(when role-to-delete
(d:delete-role parent-assoc role-to-delete :revision revision)
- t)))))
+ role-to-delete)))))
(defun delete-association-from-json (json-decoded-list &key
@@ -94,7 +94,7 @@
(let ((assoc (find-association json-decoded-list :revision revision)))
(when assoc
(d:mark-as-deleted assoc :revision revision :source-locator nil)
- t)))
+ assoc)))
(defun make-role-plist (json-decoded-list &key (revision *TM-REVISION*))
@@ -217,7 +217,7 @@
scopes (d:themes var :revision revision))))
return var))) (when var-to-delete
(delete-variant parent-name var-to-delete :revision revision)
- t)))))
+ var-to-delete)))))
(defun delete-occurrence-from-json (json-decoded-list parent-top
@@ -258,7 +258,7 @@
return occ)))
(when occ-to-delete
(delete-occurrence parent-top occ-to-delete :revision revision)
- t)))))
+ occ-to-delete)))))
(defun delete-name-from-json (json-decoded-list parent-top
@@ -287,7 +287,7 @@
return name)))
(when name-to-delete
(delete-name parent-top name-to-delete :revision revision)
- t)))))
+ name-to-delete)))))
(defun delete-identifier-from-json (uri class delete-function
@@ -302,7 +302,7 @@
(apply delete-function
(list (d:identified-construct id :revision revision)
id :revision revision))
- t)
+ id)
nil)))
@@ -314,7 +314,7 @@
json-decoded-list :revision revision)))
(when top-to-delete
(mark-as-deleted top-to-delete :source-locator nil :revision revision)
- t)))
+ top-to-delete)))
(defun get-ids-from-json (json-decoded-list)
Modified: trunk/src/rest_interface/rest-interface.lisp
==============================================================================
--- trunk/src/rest_interface/rest-interface.lisp (original)
+++ trunk/src/rest_interface/rest-interface.lisp Thu Oct 21 05:36:58 2010
@@ -81,11 +81,6 @@
(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: 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 Oct 21 05:36:58 2010
@@ -9,6 +9,11 @@
(in-package :rest-interface)
+;caching tables
+(defparameter *type-table* nil)
+(defparameter *instance-table* nil)
+
+
;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>
@@ -71,6 +76,11 @@
"registers the json im/exporter to the passed base-url in hunchentoot's dispatch-table
and also registers a file-hanlder to the html-user-interface"
+ ;initializes cache and fragments
+ (init-cache)
+ (format t "~%")
+ (init-fragments)
+
;; 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
@@ -149,7 +159,10 @@
(declare (ignorable param))
(handler-case (let ((topic-types
(with-reader-lock
- (json-tmcl::return-all-tmcl-types :revision 0))))
+ (map 'list #'(lambda (oid)
+ (elephant::controller-recreate-instance
+ elephant::*store-controller* oid))
+ *type-table*))))
(setf (hunchentoot:content-type*) "application/json") ;RFC 4627
(json:encode-json-to-string
(map 'list #'(lambda(y)
@@ -168,7 +181,10 @@
(declare (ignorable param))
(handler-case (let ((topic-instances
(with-reader-lock
- (json-tmcl::return-all-tmcl-instances :revision 0))))
+ (map 'list #'(lambda (oid)
+ (elephant::controller-recreate-instance
+ elephant::*store-controller* oid))
+ *instance-table*))))
(setf (hunchentoot:content-type*) "application/json") ;RFC 4627
(json:encode-json-to-string
(map 'list #'(lambda(y)
@@ -314,8 +330,11 @@
(eq http-method :POST))
(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 (with-writer-lock
- (json-importer:json-to-elem json-data))
+ (handler-case
+ (with-writer-lock
+ (let ((frag (json-importer:json-to-elem json-data)))
+ (when frag
+ (push-to-cache (d:topic frag)))))
(condition (err)
(progn
(setf (hunchentoot:return-code*) hunchentoot:+http-internal-server-error+)
@@ -396,7 +415,11 @@
(let ((result (json-delete-interface:mark-as-deleted-from-json
json-data :revision (d:get-revision))))
(if result
- (format nil "") ;operation succeeded
+ (progn
+ (when (typep result 'd:TopicC)
+ (delete (elephant::oid result) *type-table*)
+ (delete (elephant::oid result) *instance-table*))
+ (format nil "")) ;operation succeeded
(progn
(setf (hunchentoot:return-code*) hunchentoot:+http-not-found+)
(format nil "object not found")))))
@@ -456,3 +479,48 @@
(incf idx)))
(unless (< idx (length str))
(return ret-str)))))))
+
+
+(defun init-cache()
+ "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 "~%initialize cache: ")
+ (map 'list #'(lambda(top)
+ (format t ".")
+ (push-to-cache top topictype topictype-constraint))
+ (elephant:get-instances-by-class 'TopicC)))))
+
+
+(defun push-to-cache (topic-instance &optional
+ (topictype
+ (get-item-by-psi
+ json-tmcl::*topictype-psi* :revision 0))
+ (topictype-constraint
+ (json-tmcl::is-type-constrained :revision 0)))
+ "Pushes the given topic-instance into the correspondng cache-tables"
+ (when (not (json-tmcl::abstract-p topic-instance :revision 0))
+ (handler-case (progn
+ (json-tmcl::topictype-p
+ topic-instance topictype topictype-constraint nil 0)
+ (push (elephant::oid topic-instance) *type-table*))
+ (condition () nil)))
+ (handler-case (progn
+ (json-tmcl::valid-instance-p topic-instance nil nil 0)
+ (push (elephant::oid topic-instance) *instance-table*))
+ (condition () nil)))
+
+
+(defun init-fragments ()
+ "Creates fragments of all topics that have a PSI."
+ (format t "create 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
More information about the Isidorus-cvs
mailing list