Author: lgiessmann Date: Thu Aug 4 12:01:13 2011 New Revision: 711 Log: trunk: datamodel: improved caching of serialized fragments Modified: trunk/src/json/isidorus-json/json_exporter.lisp trunk/src/model/changes.lisp trunk/src/model/datamodel.lisp trunk/src/rest_interface/set-up-json-interface.lisp Modified: trunk/src/json/isidorus-json/json_exporter.lisp ============================================================================== --- trunk/src/json/isidorus-json/json_exporter.lisp Thu Aug 4 09:42:28 2011 (r710) +++ trunk/src/json/isidorus-json/json_exporter.lisp Thu Aug 4 12:01:13 2011 (r711) @@ -479,46 +479,4 @@ (json:encode-json-to-string (getf entry :variable)) ":" (json:encode-json-to-string (getf entry :result)) ",") j-str)) - (concat (subseq j-str 0 (- (length j-str) 1)) "}"))))) - - -;; ============================================================================= -;; --- json data fragment-serializer-cache ------------------------------------- -;; ============================================================================= - -(defgeneric set-fragment-cache (fragment) - (:documentation "sets the fragment cache, no matter if the - fragment chaged or not.") - (:method ((fragment FragmentC)) - (let ((top (topic fragment))) - (setf (slot-value fragment 'serializer-notes) - (list :psis (length (psis top :revision 0)) - :iis (length (item-identifiers top :revision 0)) - :sls (length (locators top :revision 0)) - :names (length (names top :revision 0)) - :occurrences (length (occurrences top :revision 0)) - :roles (length (player-in-roles top :revision 0)))) - (setf (slot-value fragment 'serializer-cache) - (json-exporter:export-construct-as-isidorus-json-string - fragment :revision 0)) - (serializer-cache fragment)))) - - -(defgeneric serialize-fragment (fragment) - (:documentation "returns a string that represent the isidours-json - serialization of the passed fragment instance. - This method uses the fragments serializer-cache - slot to perform faster, i.e. if the fragment has - not changed since the last time, the serializer-cache - is returned, otherwise the serialization is invoked - again.") - (:method ((fragment FragmentC)) - (cond ((null (serializer-notes fragment)) - (set-fragment-cache fragment)) - ((serializer-notes-changed-p fragment) - (set-fragment-cache fragment)) - (t - (serializer-cache fragment))))) - - - \ No newline at end of file + (concat (subseq j-str 0 (- (length j-str) 1)) "}"))))) \ No newline at end of file Modified: trunk/src/model/changes.lisp ============================================================================== --- trunk/src/model/changes.lisp Thu Aug 4 09:42:28 2011 (r710) +++ trunk/src/model/changes.lisp Thu Aug 4 12:01:13 2011 (r711) @@ -332,18 +332,6 @@ that can contain any string format, e.g. JTM, XTM, ... depending on the setter method.") - (serializer-notes :type List - :initform nil - :initarg :serializer-notes - :documentation "contains a list of the forms - (:psis <int> :iis <int> :sls <int> - :names <int> :occurrences <int> - :roles <int>) that indicates the - number of elements this fragment's - topic is bound to. It is only necessary - to recognize mark-as-deleted elements, - since newly added elements will result - in a completely new fragment.") (referenced-topics :type list :initarg :referenced-topics @@ -432,10 +420,12 @@ (find-associations top :revision revision))) -(defun create-latest-fragment-of-topic (topic-psi) +(defun create-latest-fragment-of-topic (topic-or-psi) "Returns the latest fragment of the passed topic-psi" - (declare (string topic-psi)) - (let ((topic (get-latest-topic-by-psi topic-psi))) + (declare (type (or TopicC String) topic-or-psi)) + (let ((topic (if (stringp topic-or-psi) + (get-latest-topic-by-psi topic-or-psi) + topic-or-psi))) (when topic (let ((start-revision (start-revision @@ -459,10 +449,12 @@ :topic topic))))))) -(defun get-latest-fragment-of-topic (topic-psi) +(defun get-latest-fragment-of-topic (topic-or-psi) "Returns the latest existing fragment of the passed topic-psi." - (declare (string topic-psi)) - (let ((topic (get-latest-topic-by-psi topic-psi))) + (declare (type (or String TopicC) topic-or-psi)) + (let ((topic (if (stringp topic-or-psi) + (get-latest-topic-by-psi topic-or-psi) + topic-or-psi))) (when topic (let ((existing-fragments (elephant:get-instances-by-value 'FragmentC 'topic topic))) @@ -480,30 +472,19 @@ (slot-value fragment 'serializer-cache)))) -(defgeneric serializer-notes (fragment) - (:documentation "returns the slot value of serializer-notes or nil, - if it is unbound.") - (:method ((fragment FragmentC)) - (when (slot-boundp fragment 'serializer-notes) - (slot-value fragment 'serializer-notes)))) - - -(defgeneric serializer-notes-changed-p (fragment) - (:documentation "Returns t if the serializer-notes slot contains - a value that does not correspond to the actual - values of the fragment.") - (:method ((fragment FragmentC)) - (let ((top (topic fragment)) - (sn (serializer-notes fragment))) - (or (/= (length (psis top :revision 0)) - (getf sn :psis)) - (/= (length (item-identifiers top :revision 0)) - (getf sn :iis)) - (/= (length (locators top :revision 0)) - (getf sn :sls)) - (/= (length (names top :revision 0)) - (getf sn :names)) - (/= (length (occurrences top :revision 0)) - (getf sn :occurrences)) - (/= (length (player-in-roles top :revision 0)) - (getf sn :roles)))))) \ No newline at end of file +(defgeneric serialize-fragment (fragment serializer) + (:documentation "returns a string that represents the serialization + of the passed fragment instance. + This method uses the fragments serializer-cache + slot to perform faster, i.e. if the fragment was + once serialized, the next time the cached serialized + data is used again.") + (:method ((fragment FragmentC) (serializer Function)) + (cond ((null (serializer-cache fragment)) + (setf (slot-value fragment 'serializer-cache) + (funcall serializer fragment))) + (t + (serializer-cache fragment))))) + + + \ No newline at end of file Modified: trunk/src/model/datamodel.lisp ============================================================================== --- trunk/src/model/datamodel.lisp Thu Aug 4 09:42:28 2011 (r710) +++ trunk/src/model/datamodel.lisp Thu Aug 4 12:01:13 2011 (r711) @@ -43,9 +43,8 @@ :FragmentC ;;methods, functions and macros - :serializer-notes + :serialize-fragment :serializer-cache - :serializer-notes-changed-p :instanceOf-association-p :has-identifier :get-all-identifiers-of-construct Modified: trunk/src/rest_interface/set-up-json-interface.lisp ============================================================================== --- trunk/src/rest_interface/set-up-json-interface.lisp Thu Aug 4 09:42:28 2011 (r710) +++ trunk/src/rest_interface/set-up-json-interface.lisp Thu Aug 4 12:01:13 2011 (r711) @@ -487,18 +487,53 @@ :force-text t))) (with-writer-lock (handler-case - (let ((result (json-delete-interface:mark-as-deleted-from-json - json-data :revision (d:get-revision)))) + (let* ((rev (d:get-revision)) + (result (json-delete-interface:mark-as-deleted-from-json + json-data :revision rev))) (if result (progn - (when (typep result 'd:TopicC) - (append ;;the append function is used only for suppress - ;;style warnings of unused delete return values - (setf *type-table* - (delete (elephant::oid result) *type-table*)) - (setf *instance-table* - (delete (elephant::oid result) *instance-table*)) - (remove-topic-from-list result))) + (cond ((typep result 'd:TopicC) + (setf *type-table* + (delete (elephant::oid result) *type-table*)) + (setf *instance-table* + (delete (elephant::oid result) *instance-table*)) + (remove-topic-from-list result) + (map nil (lambda(fragment) + (when (eql (d:topic fragment) result) + (elephant:drop-instance fragment))) + (elephant:get-instances-by-value + 'd:FragmentC 'd:topic result))) + ((typep result 'd:AssociationC) + (let ((players + (delete-if + #'null + (map 'list + (lambda(role) + (let ((top (player role + :revision (1- rev)))) + (when (psis top :revision 0) + top))) + (roles result :revision (1- rev)))))) + (map nil + (lambda(plr) + (map nil #'elephant:drop-instance + (elephant:get-instances-by-value + 'd:FragmentC 'd:topic plr)) + (d:serialize-fragment + (create-latest-fragment-of-topic plr) + (fragment-serializer))) + players))) + ((or (typep result 'd:NameC) + (typep result 'd:OccurrenceC)) + (let ((top (parent result :revision (1- rev)))) + (when (and top (psis top :revision 0)) + (map nil (lambda(frg) + (setf (slot-value frg 'd::serializer-cache) nil) + (d:serialize-fragment + (get-latest-fragment-of-topic top) + (fragment-serializer))) + (elephant:get-instances-by-value + 'd:FragmentC 'd:topic top)))))) (format nil "")) ;operation succeeded (progn (setf (hunchentoot:return-code*) hunchentoot:+http-not-found+) @@ -653,16 +688,24 @@ (defun init-fragments () "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 ".") - (let ((fragment - (create-latest-fragment-of-topic - (uri (first psis-of-top))))) - (json-exporter:serialize-fragment fragment) - fragment)))) - (elephant:get-instances-by-class 'd:TopicC))) + (map + nil + (lambda(top) + (let ((psis-of-top (psis top))) + (when psis-of-top + (format t ".") + (let ((fragment + (create-latest-fragment-of-topic + (uri (first psis-of-top))))) + (d:serialize-fragment fragment (fragment-serializer)) + fragment)))) + (elephant:get-instances-by-class 'd:TopicC))) + + +(defun fragment-serializer () + (lambda(frg) + (json-exporter:export-construct-as-isidorus-json-string + frg :revision 0))) (defun update-list (top psis)