From 9e4e8993aaef6a861b2237e0509eeee02089916f Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Wed, 12 Nov 2014 13:49:36 +0800 Subject: [PATCH 3/4] Sort registry entries when pruning * lisp/registry.el (registry-prune): Accept and use a sort-function argument. * lisp/gnus-registry.el (gnus-registry-default-sort-function): New customization option pointing at a sort function to use when pruning. (gnus-registry-sort-by-creation-time): Provide a default function for the above option. (gnus-registry-save, gnus-registry-insert): Use sort function. * lisp/tests/gnustest-registry.el (gnustest-registry-sort-function): Default sort function for testing. (gnustest-registry-pruning-sort-test): New test for sorting. * text/gnus.texi: Document sorting options. --- lisp/gnus-registry.el | 25 +++++++++++++++++++++++-- lisp/registry.el | 21 +++++++++++++++------ lisp/tests/gnustest-registry.el | 26 ++++++++++++++++++++++++++ texi/gnus.texi | 9 +++++++++ 4 files changed, 73 insertions(+), 8 deletions(-) diff --git a/lisp/gnus-registry.el b/lisp/gnus-registry.el index 0f3ea23..92f8f04 100644 --- a/lisp/gnus-registry.el +++ b/lisp/gnus-registry.el @@ -257,6 +257,25 @@ entries. The pruning process is constrained by the presence of :group 'gnus-registry :type 'float) +(defcustom gnus-registry-default-sort-function + #'gnus-registry-sort-by-creation-time + "Sort function to use when pruning the registry. + +Entries which sort to the front of the list will be pruned +first. + +This can slow pruning down. Set to nil to perform no sorting." + :version "24.4" + :group 'gnus-registry + :type 'symbol) + +(defun gnus-registry-sort-by-creation-time (l r) + "Sort older entries to front of list." + ;; Pruning starts from the front of the list. + (time-less-p + (cadr (assq 'creation-time r)) + (cadr (assq 'creation-time l)))) + (defun gnus-registry-fixup-registry (db) (when db (let ((old (oref db :tracked))) @@ -349,7 +368,8 @@ This is not required after changing `gnus-registry-cache-file'." (db (or db gnus-registry-db))) (gnus-message 5 "Saving Gnus registry (%d entries) to %s..." (registry-size db) file) - (registry-prune db) + (registry-prune + db gnus-registry-default-sort-function) ;; TODO: call (gnus-string-remove-all-properties v) on all elements? (eieio-persistent-save db file) (gnus-message 5 "Saving Gnus registry (size %d) to %s...done" @@ -1056,7 +1076,8 @@ only the last one's marks are returned." "Just like `registry-insert' but tries to prune on error." (when (registry-full db) (message "Trying to prune the registry because it's full") - (registry-prune db)) + (registry-prune + db gnus-registry-default-sort-function)) (registry-insert db id entry) entry) diff --git a/lisp/registry.el b/lisp/registry.el index 86e1ee3..d949e7a 100644 --- a/lisp/registry.el +++ b/lisp/registry.el @@ -334,7 +334,7 @@ Errors out if the key exists already." (registry-lookup-secondary-value db tr val value-keys)))) (oref db :data)))))) -(defmethod registry-prune ((db registry-db)) +(defmethod registry-prune ((db registry-db) &optional sortfunc) "Prunes the registry-db object DB. Attempts to prune the number of entries down to \(* @@ -343,6 +343,9 @@ pruning doesn't need to happen on every save. Removes only entries without the :precious keys, so it may not be possible to reach the target limit. +Entries to be pruned are first sorted using SORTFUNC. Entries +from the front of the list are deleted first. + Returns the number of deleted entries." (let ((size (registry-size db)) (target-size (- (oref db :max-size) @@ -352,15 +355,17 @@ Returns the number of deleted entries." (if (> size target-size) (progn (setq candidates - (registry-collect-prune-candidates db (- size target-size))) + (registry-collect-prune-candidates + db (- size target-size) sortfunc)) (length (registry-delete db candidates nil))) 0))) -(defmethod registry-collect-prune-candidates ((db registry-db) limit) +(defmethod registry-collect-prune-candidates ((db registry-db) limit sortfunc) "Collects pruning candidates from the registry-db object DB. Proposes only entries without the :precious keys, and attempts to -return LIMIT such candidates." +return LIMIT such candidates. If SORTFUNC is provided, sort +entries first and return candidates from beginning of list." (let* ((precious (oref db :precious)) (precious-p (lambda (entry-key) (cdr (memq (car entry-key) precious)))) @@ -368,8 +373,12 @@ return LIMIT such candidates." (candidates (cl-loop for k being the hash-keys of data using (hash-values v) when (notany precious-p v) - collect k))) - (delq nil (cl-subseq candidates 0 limit)))) + collect (cons k v)))) + ;; We want the full entries for sorting, but should only return a + ;; list of entry keys. + (when sortfunc + (setq candidates (sort candidates sortfunc))) + (delq nil (cl-subseq (mapcar #'car candidates) 0 limit)))) (provide 'registry) ;;; registry.el ends here diff --git a/lisp/tests/gnustest-registry.el b/lisp/tests/gnustest-registry.el index 5ca0cc0..e6ac8db 100644 --- a/lisp/tests/gnustest-registry.el +++ b/lisp/tests/gnustest-registry.el @@ -52,6 +52,11 @@ (should-not (registry--match :member entry '((hello))))) (message "Done with matching testing.")) +(defun gnustest-registry-sort-function (l r) + "Sort lower values of sort-field earlier." + (< (cadr (assq 'sort-field l)) + (cadr (assq 'sort-field r)))) + (defun gnustest-registry-make-testable-db (n &optional prune-factor name file) (let* ((db (registry-db (or name "Testing") @@ -66,6 +71,7 @@ (more-extra) ; Empty data key should be pruned. ;; First 5 entries will NOT have this extra data. ,@(when (< 4 i) (list (list 'extra "more data"))) + (sort-field ,(- n i)) (groups ,(number-to-string i))))) db)) @@ -126,6 +132,26 @@ :prefix "Error: ") (should (= expected-prune-count actual-prune-count))))))) +(ert-deftest gnustest-registry-pruning-sort-test () + "Check that entries are sorted properly before pruning." + (let ((db (gnustest-registry-make-testable-db 10 0.4)) + ;; These entries have the highest 'sort-field values. Pruning + ;; sorts by lowest values first, then prunes from the front of + ;; the list, so these entries survive + (expected-survivors '(5 6 7 8 9 0)) + actual-survivors disjunct) + (registry-prune + db #'gnustest-registry-sort-function) + (maphash (lambda (k v) (push k actual-survivors)) + (oref db :data)) + (setq disjunct (cl-set-exclusive-or + expected-survivors + actual-survivors)) + (ert-info + ((format "Incorrect pruning: %s" disjunct) + :prefix "Error: ") + (should (null disjunct))))) + (ert-deftest gnustest-registry-persistence-test () (let* ((n 100) (tempfile (make-temp-file "registry-persistence-")) diff --git a/texi/gnus.texi b/texi/gnus.texi index ca7ddfe..9255ed9 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -25958,6 +25958,15 @@ cut back to 45000 entries. Entries with keys marked as precious will not be pruned. @end defvar +@defvar gnus-registry-default-sort-function +This option specifies how registry entries are sorted during pruning. +If a function is given, it should sort least valuable entries first, +as pruning starts from the beginning of the list. The default value +is @code{gnus-registry-sort-by-creation-time}, which proposes the +oldest entries for pruning. Set to nil to perform no sorting, which +will speed up the pruning process. +@end defvar + @defvar gnus-registry-cache-file The file where the registry will be stored between Gnus sessions. By default the file name is @code{.gnus.registry.eieio} in the same -- 2.1.3