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