Commit d20acfe0 authored by Eric Abrahamsen's avatar Eric Abrahamsen Committed by Katsumi Yamaoka
Browse files

Fix Gnus registry pruning and sorting, and rename file

* lisp/gnus/gnus-registry.el (gnus-registry-prune-factor): Add new variable.
(gnus-registry-max-pruned-entries): Remove obsolete variable.
(gnus-registry-cache-file): Change default
filename extension to "eieio".
(gnus-registry-read): Add new function, split out from
`gnus-registry-load', that does the actual object reading.
(gnus-registry-load): Use it. Add condition case handler to check for
old filename extension and rename to the new one.
(gnus-registry-default-sort-function): New variable to specify a sort
function to use when pruning.
(gnus-registry-save, gnus-registry-insert): Use it.
(gnus-registry-sort-by-creation-time): Define a default sort function.

* lisp/gnus/registry.el (registry-db): Consolidate the :max-hard and
:max-soft slots into a :max-size slot.
(registry-db-version): Add new variable for database version number.
(registry-prune): Use :max-size slot. Accept and use a sort-function
argument.
(registry-collect-prune-candidates): Add new function for finding
non-precious pruning candidates.
(registry-prune-hard-candidates, registry-prune-soft-candidates):
Remove obsolete functions.
(initialize-instance): Upgrade registry version when starting.

* doc/misc/gnus.texi (Gnus Registry Setup): Explain pruning changes.
Mention gnus-registry-prune-factor. Explain sorting changes and
gnus-registry-default-sort-function. Correct file extension.
parent 18d4bdf1
2014-12-18 Eric Abrahamsen <eric@ericabrahamsen.net>
* gnus.texi (Gnus Registry Setup): Explain pruning changes. Mention
gnus-registry-prune-factor. Explain sorting changes and
gnus-registry-default-sort-function. Correct file extension.
2014-12-17 Jay Belanger <jay.p.belanger@gmail.com>
* calc.texi (About This Manual): Update instructions
......
......@@ -25953,17 +25953,34 @@ 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-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.eioio} in the same
default the file name is @code{.gnus.registry.eieio} in the same
directory as your @code{.newsrc.eld}.
@end defvar
2014-12-18 Eric Abrahamsen <eric@ericabrahamsen.net>
* registry.el (registry-db): Consolidate the :max-hard and :max-soft
slots into a :max-size slot.
(registry-db-version): Add new variable for database version number.
(registry-prune): Use :max-size slot. Accept and use a sort-function
argument.
(registry-collect-prune-candidates): Add new function for finding
non-precious pruning candidates.
(registry-prune-hard-candidates, registry-prune-soft-candidates):
Remove obsolete functions.
(initialize-instance): Upgrade registry version when starting.
* gnus-registry.el (gnus-registry-prune-factor): Add new variable.
(gnus-registry-max-pruned-entries): Remove obsolete variable.
(gnus-registry-cache-file): Change default
filename extension to "eieio".
(gnus-registry-read): Add new function, split out from
`gnus-registry-load', that does the actual object reading.
(gnus-registry-load): Use it. Add condition case handler to check for
old filename extension and rename to the new one.
(gnus-registry-default-sort-function): New variable to specify a sort
function to use when pruning.
(gnus-registry-save, gnus-registry-insert): Use it.
(gnus-registry-sort-by-creation-time): Define a default sort function.
2014-12-09 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus-art.el (gnus-article-mime-handles): Refactored out into own
......
......@@ -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.
......@@ -231,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)
......@@ -242,12 +243,38 @@ 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)
(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
......@@ -255,14 +282,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 +303,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)))
......@@ -295,22 +320,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
......@@ -318,6 +348,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)
......@@ -325,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"
......@@ -1032,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)
......@@ -1090,7 +1135,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
......@@ -1104,7 +1149,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))
......@@ -1117,7 +1162,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))
......
......@@ -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
......@@ -82,28 +83,32 @@
(require 'eieio)
(require 'eieio-base)
;; 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
......@@ -119,6 +124,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
......@@ -255,7 +277,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.
......@@ -267,7 +289,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))
......@@ -300,58 +322,51 @@ 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) &optional sortfunc)
"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.
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)
(* (oref db :max-size)
(oref db :prune-factor))))
candidates)
(if (> size target-size)
(progn
(setq candidates
(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 sortfunc)
"Collects pruning candidates from the registry-db object DB.
Proposes only entries without the :precious keys, and attempts to
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))))
(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 (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
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment