From mboxrd@z Thu Jan 1 00:00:00 1970 X-Msuck: nntp://news.gmane.io/gmane.emacs.gnus.general/85278 Path: news.gmane.org!not-for-mail From: Eric Abrahamsen Newsgroups: gmane.emacs.gnus.general Subject: Re: [PATCH] Two issues with the gnus-registry Date: Thu, 13 Nov 2014 20:05:38 +0800 Message-ID: <8761ej8fvx.fsf@ericabrahamsen.net> References: <87egtx70hy.fsf@ericabrahamsen.net> <87wq7lsggo.fsf@lifelogs.com> <87zjchxr1v.fsf@ericabrahamsen.net> <87h9yogjer.fsf@ericabrahamsen.net> <87a942lg39.fsf@ericabrahamsen.net> <8761eqlfvk.fsf@ericabrahamsen.net> <87mw82jdbf.fsf@ericabrahamsen.net> <87bnoff9fq.fsf@lifelogs.com> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1415892713 6721 80.91.229.3 (13 Nov 2014 15:31:53 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Thu, 13 Nov 2014 15:31:53 +0000 (UTC) To: ding@gnus.org Original-X-From: ding-owner+M33522@lists.math.uh.edu Thu Nov 13 16:31:46 2014 Return-path: Envelope-to: ding-account@gmane.org Original-Received: from util0.math.uh.edu ([129.7.128.18]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1XowN7-0002sN-Gd for ding-account@gmane.org; Thu, 13 Nov 2014 16:31:46 +0100 Original-Received: from localhost ([127.0.0.1] helo=lists.math.uh.edu) by util0.math.uh.edu with smtp (Exim 4.63) (envelope-from ) id 1XowMG-00048f-3i; Thu, 13 Nov 2014 09:30:52 -0600 Original-Received: from mx1.math.uh.edu ([129.7.128.32]) by util0.math.uh.edu with esmtps (TLSv1:AES256-SHA:256) (Exim 4.63) (envelope-from ) id 1Xot4w-0003EE-7R for ding@lists.math.uh.edu; Thu, 13 Nov 2014 06:00:46 -0600 Original-Received: from quimby.gnus.org ([80.91.231.51]) by mx1.math.uh.edu with esmtps (TLSv1:AES128-SHA:128) (Exim 4.76) (envelope-from ) id 1Xot4s-00068F-0m for ding@lists.math.uh.edu; Thu, 13 Nov 2014 06:00:45 -0600 Original-Received: from plane.gmane.org ([80.91.229.3]) by quimby.gnus.org with esmtp (Exim 4.80) (envelope-from ) id 1Xot4p-0007tO-9G for ding@gnus.org; Thu, 13 Nov 2014 13:00:39 +0100 Original-Received: from list by plane.gmane.org with local (Exim 4.69) (envelope-from ) id 1Xot4o-0004Gu-4f for ding@gnus.org; Thu, 13 Nov 2014 13:00:38 +0100 Original-Received: from 123.123.17.194 ([123.123.17.194]) by main.gmane.org with esmtp (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Thu, 13 Nov 2014 13:00:38 +0100 Original-Received: from eric by 123.123.17.194 with local (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Thu, 13 Nov 2014 13:00:38 +0100 X-Injected-Via-Gmane: http://gmane.org/ Original-Lines: 864 Original-X-Complaints-To: usenet@ger.gmane.org X-Gmane-NNTP-Posting-Host: 123.123.17.194 User-Agent: Gnus/5.130012 (Ma Gnus v0.12) Emacs/24.4 (gnu/linux) Cancel-Lock: sha1:z+qP/X2uBgscs7EVRwwndS92tIg= X-Spam-Score: -0.7 (/) List-ID: Precedence: bulk Xref: news.gmane.org gmane.emacs.gnus.general:85278 Archived-At: --=-=-= Content-Type: text/plain Ted Zlatanov writes: > On Sat, 08 Nov 2014 16:39:48 +0800 Eric Abrahamsen wrote: > > EA> So unless I'm really missing something, my proposal is: > > EA> 1. Only provide one limit: max-size. > EA> 2. Allow customization of prune-factor. > > EA> That seems like all the customization you'd need. Cap the size, and > EA> provide a reasonable control of how often the registry gets pruned. > > OK. I am afraid I made the whole thing too complicated and it took > another set of eyes to recognize it. Thanks for that, and the fixes. > > Please go ahead and apply any changes you have in mind. I am sure no one > is tuning soft/hard pruning. Simpler is definitely better. > > EA> That would require a change in the object signature, which would mean > EA> some extra handling code for "upgrading". But once we're doing that, we > EA> could also take the opportunity to add :prune-function and > EA> :sort-function slots on the base registry object, which would be > EA> nice. We could even change the default store filename from its "eioio" > EA> extension to "eieio". :) > > Yeah, I remember that bug report about the extension of the database > file, if we're upgrading anyway... It's a good chance to batch these > changes. Okay, here is Stab the First. Most of what's happening should be evident from commit messages and code comments. There are three patches: 1. The big one changes the database structure, combining :max-hard and :max-soft into :max-size, and reworking the pruning routine to only make a single pass. This also includes a new initialize-instance method for upgrading from older versions, and the extraction of the database version into a new defvar: see the comments on top of `registry-db-version'. 2. The second patch changes the default filename to a eieio extension, which necessitated more code than I thought -- `gnus-registry-read' is split into two functions. I hope this isn't too crufty. 3. Number three introduces sorting into the pruning process. I considered adding a sorting function as a slot on the registry-db objects, but couldn't immediately think of why that was really necessary. Anyway, there's a new option `gnus-registry-default-sorting-function', which defaults to a function that sorts by 'creation-time. Tests and documentation all around. Presumably there are bugs! I hope people will test. Eric --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0003-Sort-registry-entries-when-pruning.patch >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 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0002-Change-default-registry-filename-extension.patch >From 2ef0a99726eaeaab7831fa2cd7af0e3dd12c5e72 Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Wed, 12 Nov 2014 13:04:24 +0800 Subject: [PATCH 2/4] Change default registry filename extension * lisp/gnus-registry.el (gnus-registry-cache-file): Change default filename extension to "eieio". (gnus-registry-read): New function, split out from `gnus-registry-load', that does the actual object reading. (gnus-registry-load): Refactor to call new function `gnus-registry-read', also add condition case handler to check for old filename extension --- lisp/gnus-registry.el | 52 ++++++++++++++++++++++++++++++++++----------------- texi/gnus.texi | 2 +- 2 files changed, 36 insertions(+), 18 deletions(-) diff --git a/lisp/gnus-registry.el b/lisp/gnus-registry.el index d3f6546..0f3ea23 100644 --- a/lisp/gnus-registry.el +++ b/lisp/gnus-registry.el @@ -232,7 +232,7 @@ the Bit Bucket." (defcustom gnus-registry-cache-file (nnheader-concat (or gnus-dribble-directory gnus-home-directory "~/") - ".gnus.registry.eioio") + ".gnus.registry.eieio") "File where the Gnus registry will be stored." :group 'gnus-registry :type 'file) @@ -301,22 +301,27 @@ This is not required after changing `gnus-registry-cache-file'." (gnus-message 4 "Remaking the Gnus registry") (setq gnus-registry-db (gnus-registry-make-db)))) -(defun gnus-registry-read () - "Read the registry cache file." +(defun gnus-registry-load () + "Load the registry from the cache file." (interactive) (let ((file gnus-registry-cache-file)) (condition-case nil - (progn - (gnus-message 5 "Reading Gnus registry from %s..." file) - (setq gnus-registry-db - (gnus-registry-fixup-registry - (condition-case nil - (with-no-warnings - (eieio-persistent-read file 'registry-db)) - ;; Older EIEIO versions do not check the class name. - ('wrong-number-of-arguments - (eieio-persistent-read file))))) - (gnus-message 5 "Reading Gnus registry from %s...done" file)) + (gnus-registry-read file) + (file-error + ;; Fix previous mis-naming of the registry file. + (let ((old-file-name + (concat (file-name-sans-extension + gnus-registry-cache-file) + ".eioio"))) + (if (and (file-exists-p old-file-name) + (yes-or-no-p + (format "Rename registry file from %s to %s? " + old-file-name file))) + (progn + (gnus-registry-read old-file-name) + (oset gnus-registry-db :file file) + (gnus-message 1 "Registry filename changed to %s" file)) + (gnus-registry-remake-db t)))) (error (gnus-message 1 @@ -324,6 +329,19 @@ This is not required after changing `gnus-registry-cache-file'." file) (gnus-registry-remake-db t))))) +(defun gnus-registry-read (file) + "Do the actual reading of the registry persistence file." + (gnus-message 5 "Reading Gnus registry from %s..." file) + (setq gnus-registry-db + (gnus-registry-fixup-registry + (condition-case nil + (with-no-warnings + (eieio-persistent-read file 'registry-db)) + ;; Older EIEIO versions do not check the class name. + ('wrong-number-of-arguments + (eieio-persistent-read file))))) + (gnus-message 5 "Reading Gnus registry from %s...done" file)) + (defun gnus-registry-save (&optional file db) "Save the registry cache file." (interactive) @@ -1096,7 +1114,7 @@ only the last one's marks are returned." (gnus-message 5 "Initializing the registry") (gnus-registry-install-hooks) (gnus-registry-install-shortcuts) - (gnus-registry-read)) + (gnus-registry-load)) ;; FIXME: Why autoload this function? ;;;###autoload @@ -1110,7 +1128,7 @@ only the last one's marks are returned." (add-hook 'nnmail-spool-hook 'gnus-registry-spool-action) (add-hook 'gnus-save-newsrc-hook 'gnus-registry-save) - (add-hook 'gnus-read-newsrc-el-hook 'gnus-registry-read) + (add-hook 'gnus-read-newsrc-el-hook 'gnus-registry-load) (add-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids)) @@ -1123,7 +1141,7 @@ only the last one's marks are returned." (remove-hook 'nnmail-spool-hook 'gnus-registry-spool-action) (remove-hook 'gnus-save-newsrc-hook 'gnus-registry-save) - (remove-hook 'gnus-read-newsrc-el-hook 'gnus-registry-read) + (remove-hook 'gnus-read-newsrc-el-hook 'gnus-registry-load) (remove-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids) (setq gnus-registry-enabled nil)) diff --git a/texi/gnus.texi b/texi/gnus.texi index 082adad..ca7ddfe 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -25960,7 +25960,7 @@ not be pruned. @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.eioio} in the same +default the file name is @code{.gnus.registry.eieio} in the same directory as your @code{.newsrc.eld}. @end defvar -- 2.1.3 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0001-Alter-registry-database-to-fix-pruning-issues.patch >From 7da7dc2222137b03ff8f54e61ac0c519b7316f0c Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Wed, 12 Nov 2014 12:59:45 +0800 Subject: [PATCH 1/4] Alter registry database to fix pruning issues * lisp/registry.el (registry-db): Consolidate the :max-hard and :max-soft slots into a :max-size slot. (registry-db-version): New defvar, holding database version number. (registry-prune): Use :max-size slot (registry-collect-prune-candidates): New function for finding non-precious pruning candidates (registry-prune-hard-candidates, registry-prune-soft-candidates): Remove functions (initialize-instance): Perform registry version upgrade * lisp/gnus-registry.el (gnus-registry-prune-factor): New custom option (gnus-registry-max-pruned-entries): Remove option * lisp/tests/gnustest-registry.el (gnustest-registry-make-testable-db): Alter for new object signature (gnustest-registry-pruning-test): New pruning test * texi/gnus.texi (Gnus Registry Setup): Document changes --- lisp/gnus-registry.el | 30 ++++---- lisp/registry.el | 150 +++++++++++++++++++++------------------- lisp/tests/gnustest-registry.el | 50 +++++++++----- texi/gnus.texi | 16 +++-- 4 files changed, 140 insertions(+), 106 deletions(-) diff --git a/lisp/gnus-registry.el b/lisp/gnus-registry.el index f3b81f7..d3f6546 100644 --- a/lisp/gnus-registry.el +++ b/lisp/gnus-registry.el @@ -176,6 +176,7 @@ nnmairix groups are specifically excluded because they are ephemeral." (make-obsolete-variable 'gnus-registry-max-track-groups nil "23.4") (make-obsolete-variable 'gnus-registry-entry-caching nil "23.4") (make-obsolete-variable 'gnus-registry-trim-articles-without-groups nil "23.4") +(make-obsolete-variable 'gnus-registry-max-pruned-entries nil "24.4") (defcustom gnus-registry-track-extra '(subject sender recipient) "Whether the registry should track extra data about a message. @@ -242,12 +243,19 @@ the Bit Bucket." :type '(radio (const :format "Unlimited " nil) (integer :format "Maximum number: %v"))) -(defcustom gnus-registry-max-pruned-entries nil - "Maximum number of pruned entries in the registry, nil for unlimited." - :version "24.1" +(defcustom gnus-registry-prune-factor 0.1 + "When pruning, try to prune back to this factor less than the maximum size. + +In order to prevent constant pruning, we prune back to a number +somewhat less than the maximum size. This option controls +exactly how much less. For example, given a maximum size of +50000 and a prune factor of 0.1, the pruning process will try to +cut the registry back to \(- 50000 \(* 50000 0.1\)\) -> 45000 +entries. The pruning process is constrained by the presence of +\"precious\" entries." + :version "24.4" :group 'gnus-registry - :type '(radio (const :format "Unlimited " nil) - (integer :format "Maximum number: %v"))) + :type 'float) (defun gnus-registry-fixup-registry (db) (when db @@ -255,14 +263,12 @@ the Bit Bucket." (oset db :precious (append gnus-registry-extra-entries-precious '())) - (oset db :max-hard + (oset db :max-size (or gnus-registry-max-entries most-positive-fixnum)) (oset db :prune-factor - 0.1) - (oset db :max-soft - (or gnus-registry-max-pruned-entries - most-positive-fixnum)) + (or gnus-registry-prune-factor + 0.1)) (oset db :tracked (append gnus-registry-track-extra '(mark group keyword))) @@ -278,8 +284,8 @@ the Bit Bucket." "Gnus Registry" :file (or file gnus-registry-cache-file) ;; these parameters are set in `gnus-registry-fixup-registry' - :max-hard most-positive-fixnum - :max-soft most-positive-fixnum + :max-size most-positive-fixnum + :version registry-db-version :precious nil :tracked nil))) diff --git a/lisp/registry.el b/lisp/registry.el index dbc7b51..86e1ee3 100644 --- a/lisp/registry.el +++ b/lisp/registry.el @@ -25,11 +25,11 @@ ;; This library provides a general-purpose EIEIO-based registry ;; database with persistence, initialized with these fields: -;; version: a float, 0.1 currently (don't change it) +;; version: a float -;; max-hard: an integer, default 5000000 +;; max-size: an integer, default 50000 -;; max-soft: an integer, default 50000 +;; prune-factor: a float between 0 and 1, default 0.1 ;; precious: a list of symbols @@ -57,14 +57,15 @@ ;; Note that whether a field has one or many pieces of data, the data ;; is always a list of values. -;; The user decides which fields are "precious", F2 for example. At -;; PRUNE TIME (when the :prune-function is called), the registry will -;; trim any entries without the F2 field until the size is :max-soft -;; or less. No entries with the F2 field will be removed at PRUNE -;; TIME. +;; The user decides which fields are "precious", F2 for example. When +;; the registry is pruned, any entries without the F2 field will be +;; removed until the size is :max-size * :prune-factor _less_ than the +;; maximum database size. No entries with the F2 field will be removed +;; at PRUNE TIME, which means it may not be possible to prune back all +;; the way to the target size. -;; When an entry is inserted, the registry will reject new entries -;; if they bring it over the max-hard limit, even if they have the F2 +;; When an entry is inserted, the registry will reject new entries if +;; they bring it over the :max-size limit, even if they have the F2 ;; field. ;; The user decides which fields are "tracked", F1 for example. Any @@ -94,28 +95,32 @@ (error "eieio not found in `load-path' or gnus-fallback-lib/ directory."))) +;; The version number needs to be kept outside of the class definition +;; itself. The persistent-save process does *not* write to file any +;; slot values that are equal to the default :initform value. If a +;; database object is at the most recent version, therefore, its +;; version number will not be written to file. That makes it +;; difficult to know when a database needs to be upgraded. +(defvar registry-db-version 0.2 + "The current version of the registry format.") + (defclass registry-db (eieio-persistent) ((version :initarg :version - :initform 0.1 - :type float - :custom float + :initform nil + :type (or null float) :documentation "The registry version.") - (max-hard :initarg :max-hard - :initform 5000000 - :type integer - :custom integer - :documentation "Never accept more than this many elements.") - (max-soft :initarg :max-soft - :initform 50000 + (max-size :initarg :max-size + :initform most-positive-fixnum :type integer :custom integer - :documentation "Prune as much as possible to get to this size.") + :documentation "The maximum number of registry entries.") (prune-factor :initarg :prune-factor :initform 0.1 :type float :custom float - :documentation "At the max-hard limit, prune size * this entries.") + :documentation "Prune to \(:max-size * :prune-factor\) less + than the :max-size limit. Should be a float between 0 and 1.") (tracked :initarg :tracked :initform nil :type t @@ -131,6 +136,23 @@ :type hash-table :documentation "The data hashtable."))) +(defmethod initialize-instance :BEFORE ((this registry-db) slots) + "Check whether a registry object needs to be upgraded." + ;; Hardcoded upgrade routines. Version 0.1 to 0.2 requires the + ;; :max-soft slot to disappear, and the :max-hard slot to be renamed + ;; :max-size. + (let ((current-version + (and (plist-member slots :version) + (plist-get slots :version)))) + (when (or (null current-version) + (eql current-version 0.1)) + (setq slots + (plist-put slots :max-size (plist-get slots :max-hard))) + (setq slots + (plist-put slots :version registry-db-version)) + (cl-remf slots :max-hard) + (cl-remf slots :max-soft)))) + (defmethod initialize-instance :AFTER ((this registry-db) slots) "Set value of data slot of THIS after initialization." (with-slots (data tracker) this @@ -267,7 +289,7 @@ This is the key count of the :data slot." (defmethod registry-full ((db registry-db)) "Checks if registry-db THIS is full." (>= (registry-size db) - (oref db :max-hard))) + (oref db :max-size))) (defmethod registry-insert ((db registry-db) key entry) "Insert ENTRY under KEY into the registry-db THIS. @@ -279,7 +301,7 @@ Errors out if the key exists already." (assert (not (registry-full db)) nil - "registry max-hard size limit reached") + "registry max-size limit reached") ;; store the entry (puthash key entry (oref db :data)) @@ -312,58 +334,42 @@ 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) &optional sortfun) - "Prunes the registry-db object THIS. -Removes only entries without the :precious keys if it can, -then removes oldest entries first. -Returns the number of deleted entries. -If SORTFUN is given, tries to keep entries that sort *higher*. -SORTFUN is passed only the two keys so it must look them up directly." - (dolist (collector '(registry-prune-soft-candidates - registry-prune-hard-candidates)) - (let* ((size (registry-size db)) - (collected (funcall collector db)) - (limit (nth 0 collected)) - (candidates (nth 1 collected)) - ;; sort the candidates if SORTFUN was given - (candidates (if sortfun (sort candidates sortfun) candidates)) - (candidates-count (length candidates)) - ;; are we over max-soft? - (prune-needed (> size limit))) - - ;; while we have more candidates than we need to remove... - (while (and (> candidates-count (- size limit)) candidates) - (decf candidates-count) - (setq candidates (cdr candidates))) - - (registry-delete db candidates nil) - (length candidates)))) - -(defmethod registry-prune-soft-candidates ((db registry-db)) - "Collects pruning candidates from the registry-db object THIS. -Proposes only entries without the :precious keys." +(defmethod registry-prune ((db registry-db)) + "Prunes the registry-db object DB. + +Attempts to prune the number of entries down to \(* +:max-size :prune-factor\) less than the max-size limit, so +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. + +Returns the number of deleted entries." + (let ((size (registry-size db)) + (target-size (- (oref db :max-size) + (* (oref db :max-size) + (oref db :prune-factor)))) + candidates) + (if (> size target-size) + (progn + (setq candidates + (registry-collect-prune-candidates db (- size target-size))) + (length (registry-delete db candidates nil))) + 0))) + +(defmethod registry-collect-prune-candidates ((db registry-db) limit) + "Collects pruning candidates from the registry-db object DB. + +Proposes only entries without the :precious keys, and attempts to +return LIMIT such candidates." (let* ((precious (oref db :precious)) (precious-p (lambda (entry-key) (cdr (memq (car entry-key) precious)))) (data (oref db :data)) - (limit (oref db :max-soft)) - (candidates (loop for k being the hash-keys of data - using (hash-values v) - when (notany precious-p v) - collect k))) - (list limit candidates))) - -(defmethod registry-prune-hard-candidates ((db registry-db)) - "Collects pruning candidates from the registry-db object THIS. -Proposes any entries over the max-hard limit minus size * prune-factor." - (let* ((data (oref db :data)) - ;; prune to (size * prune-factor) below the max-hard limit so - ;; we're not pruning all the time - (limit (max 0 (- (oref db :max-hard) - (* (registry-size db) (oref db :prune-factor))))) - (candidates (loop for k being the hash-keys of data - collect k))) - (list limit 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)))) (provide 'registry) ;;; registry.el ends here diff --git a/lisp/tests/gnustest-registry.el b/lisp/tests/gnustest-registry.el index 174a0cb..5ca0cc0 100644 --- a/lisp/tests/gnustest-registry.el +++ b/lisp/tests/gnustest-registry.el @@ -52,20 +52,20 @@ (should-not (registry--match :member entry '((hello))))) (message "Done with matching testing.")) -(defun gnustest-registry-make-testable-db (n &optional name file) +(defun gnustest-registry-make-testable-db (n &optional prune-factor name file) (let* ((db (registry-db (or name "Testing") :file (or file "unused") - :max-hard n - :max-soft 0 ; keep nothing not precious + :max-size n + :prune-factor (or prune-factor 0.1) :precious '(extra more-extra) :tracked '(sender subject groups)))) (dotimes (i n) (registry-insert db i `((sender "me") (subject "about you") - (more-extra) ; empty data key should be pruned - ;; first 5 entries will NOT have this extra data - ,@(when (< 5 i) (list (list 'extra "more data"))) + (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"))) (groups ,(number-to-string i))))) db)) @@ -101,22 +101,36 @@ (should (= n (length (registry-search db :all t)))) (message "Secondary search after delete") (should (= n (length (registry-lookup-secondary-value db 'sender "me")))) - ;; (message "Pruning") - ;; (let* ((tokeep (registry-search db :member '((extra "more data")))) - ;; (count (- n (length tokeep))) - ;; (pruned (registry-prune db)) - ;; (prune-count (length pruned))) - ;; (message "Expecting to prune %d entries and pruned %d" - ;; count prune-count) - ;; (should (and (= count 5) - ;; (= count prune-count)))) (message "Done with usage testing."))) +(ert-deftest gnustest-registry-pruning-test () + "Check that precious entries are never pruned." + (let ((dbs (list + ;; Can prune fully without touching precious entries. + (gnustest-registry-make-testable-db 10 0.1) + ;; Pruning limited by precious entries. + (gnustest-registry-make-testable-db 10 0.6)))) + (dolist (db dbs) + (message "Pruning") + (let* ((size (registry-size db)) + (limit (- (oref db :max-size) + (* (oref db :max-size) + (oref db :prune-factor)))) + (keepers (registry-search db :member '((extra "more data")))) + (expected-prune-count (min (- size (length keepers)) + (- size limit))) + (actual-prune-count (registry-prune db))) + (ert-info + ((format "Expected to prune %d entries but pruned %d" + expected-prune-count actual-prune-count) + :prefix "Error: ") + (should (= expected-prune-count actual-prune-count))))))) + (ert-deftest gnustest-registry-persistence-test () (let* ((n 100) (tempfile (make-temp-file "registry-persistence-")) (name "persistence tester") - (db (gnustest-registry-make-testable-db n name tempfile)) + (db (gnustest-registry-make-testable-db n nil name tempfile)) size back) (message "Saving to %s" tempfile) (eieio-persistent-save db) @@ -205,8 +219,8 @@ (should (= (registry-size back) n)) (should (= (registry-size back) (registry-size db))) (delete-file tempfile) - (message "Pruning Gnus registry to 0 by setting :max-soft") - (oset db :max-soft 0) + (message "Pruning Gnus registry to 0 by setting :max-size") + (oset db :max-size 0) (registry-prune db) (should (= (registry-size db) 0))) (message "Done with Gnus registry usage testing.")) diff --git a/texi/gnus.texi b/texi/gnus.texi index 6f47786..082adad 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -25942,12 +25942,20 @@ the word ``archive'' is not followed. @defvar gnus-registry-max-entries The number (an integer or @code{nil} for unlimited) of entries the -registry will keep. +registry will keep. If the registry has reached or exceeded this +size, it will reject insertion of new entries. @end defvar -@defvar gnus-registry-max-pruned-entries -The maximum number (an integer or @code{nil} for unlimited) of entries -the registry will keep after pruning. +@defvar gnus-registry-prune-factor +This option (a float between 0 and 1) controls how much the registry +is cut back during pruning. In order to prevent constant pruning, the +registry will be pruned back to less than +@code{gnus-registry-max-entries}. This option controls exactly how +much less: the target is calculated as the maximum number of entries +minus the maximum number times this factor. The default is 0.1: +i.e. if your registry is limited to 50000 entries, pruning will try to +cut back to 45000 entries. Entries with keys marked as precious will +not be pruned. @end defvar @defvar gnus-registry-cache-file -- 2.1.3 --=-=-=--