[isidorus-cvs] r711 - in trunk/src: json/isidorus-json model rest_interface
lgiessmann at common-lisp.net
lgiessmann at common-lisp.net
Thu Aug 4 19:01:14 UTC 2011
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)
More information about the Isidorus-cvs
mailing list