Author: lgiessmann Date: Thu Aug 4 08:25:31 2011 New Revision: 708

Log: trunk: datamode + json-exporter: implemented cahcing for the isidorus-json serialization format of fragments, i.e. a fragment is only serialized if it has changed, otherwise the stored serialization string is returned. The serialization string itself is created if the fragment changed and added to the slot serializer-cache of each fragment instance

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 06:35:48 2011 (r707) +++ trunk/src/json/isidorus-json/json_exporter.lisp Thu Aug 4 08:25:31 2011 (r708) @@ -12,7 +12,8 @@ (:export :export-construct-as-isidorus-json-string :get-all-topic-psis :to-json-string-summary - :make-topic-summary)) + :make-topic-summary + :serialize-fragment))

(in-package :json-exporter)

@@ -478,4 +479,46 @@ (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)) "}"))))) \ No newline at end of file + (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

Modified: trunk/src/model/changes.lisp ============================================================================== --- trunk/src/model/changes.lisp Thu Aug 4 06:35:48 2011 (r707) +++ trunk/src/model/changes.lisp Thu Aug 4 08:25:31 2011 (r708) @@ -324,6 +324,26 @@ :accessor topic :index t :documentation "changed topic (topicSI in Atom") + (serializer-cache :type String + :initform nil + :initarg :serializer-cache + :documentation "contains te serialized string + value of this FragmentC instance, + 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 @@ -449,4 +469,41 @@ (when existing-fragments (first (sort existing-fragments #'(lambda(frg-1 frg-2) - (> (revision frg-1) (revision frg-2)))))))))) \ No newline at end of file + (> (revision frg-1) (revision frg-2)))))))))) + + +(defgeneric serializer-cache (fragment) + (:documentation "returns the slot value of serializer-cache or nil, + if it is unbound.") + (:method ((fragment FragmentC)) + (when (slot-boundp fragment 'serializer-cache) + (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

Modified: trunk/src/model/datamodel.lisp ============================================================================== --- trunk/src/model/datamodel.lisp Thu Aug 4 06:35:48 2011 (r707) +++ trunk/src/model/datamodel.lisp Thu Aug 4 08:25:31 2011 (r708) @@ -43,6 +43,9 @@ :FragmentC

;;methods, functions and macros + :serializer-notes + :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 06:35:48 2011 (r707) +++ trunk/src/rest_interface/set-up-json-interface.lisp Thu Aug 4 08:25:31 2011 (r708) @@ -657,7 +657,11 @@ (let ((psis-of-top (psis top))) (when psis-of-top (format t ".") - (create-latest-fragment-of-topic (uri (first psis-of-top)))))) + (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)))