- (assert (not (gethash key (oref db :data))) nil
- "Key already exists in database")
-
- (assert (not (registry-full db))
- nil
- "registry max-hard size limit reached")
-
- ;; store the entry
- (puthash key entry (oref db :data))
-
- ;; store the secondary indices
- (dolist (tr (oref db :tracked))
- ;; for every value in the entry under that key...
- (dolist (val (cdr-safe (assq tr entry)))
- (let* ((value-keys (registry-lookup-secondary-value db tr val)))
- (pushnew key value-keys :test 'equal)
- (registry-lookup-secondary-value db tr val value-keys))))
- entry)
-
- (defmethod registry-reindex ((db registry-db))
- "Rebuild the secondary indices of registry-db THIS."
- (let ((count 0)
- (expected (* (length (oref db :tracked)) (registry-size db))))
- (dolist (tr (oref db :tracked))
- (let (values)
- (maphash
- (lambda (key v)
- (incf count)
- (when (and (< 0 expected)
- (= 0 (mod count 1000)))
- (message "reindexing: %d of %d (%.2f%%)"
- count expected (/ (* 100 count) expected)))
- (dolist (val (cdr-safe (assq tr v)))
- (let* ((value-keys (registry-lookup-secondary-value db tr val)))
- (push key value-keys)
- (registry-lookup-secondary-value db tr val value-keys))))
- (oref db :data))))))
-
- (defmethod registry-size ((db registry-db))
- "Returns the size of the registry-db object THIS.
-This is the key count of the :data slot."
- (hash-table-count (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."
- (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))))
-
-(ert-deftest registry-instantiation-test ()
- (should (registry-db "Testing")))
-
-(ert-deftest registry-match-test ()
- (let ((entry '((hello "goodbye" "bye") (blank))))
-
- (message "Testing :regex matching")
- (should (registry--match :regex entry '((hello "nye" "bye"))))
- (should (registry--match :regex entry '((hello "good"))))
- (should-not (registry--match :regex entry '((hello "nye"))))
- (should-not (registry--match :regex entry '((hello))))
-
- (message "Testing :member matching")
- (should (registry--match :member entry '((hello "bye"))))
- (should (registry--match :member entry '((hello "goodbye"))))
- (should-not (registry--match :member entry '((hello "good"))))
- (should-not (registry--match :member entry '((hello "nye"))))
- (should-not (registry--match :member entry '((hello)))))
- (message "Done with matching testing."))
-
-(defun registry-make-testable-db (n &optional name file)
- (let* ((db (registry-db
- (or name "Testing")
- :file (or file "unused")
- :max-hard n
- :max-soft 0 ; keep nothing not precious
- :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")))
- (groups ,(number-to-string i)))))
- db))
+ (assert (not (gethash key (oref db data))) nil
+ "Key already exists in database")
+
+ (assert (not (registry-full db))
+ nil
+ "registry max-size limit reached")
+
+ ;; store the entry
+ (puthash key entry (oref db data))
+
+ ;; store the secondary indices
+ (dolist (tr (oref db tracked))
+ ;; for every value in the entry under that key...
+ (dolist (val (cdr-safe (assq tr entry)))
+ (let* ((value-keys (registry-lookup-secondary-value db tr val)))
+ (pushnew key value-keys :test 'equal)
+ (registry-lookup-secondary-value db tr val value-keys))))
+ entry)
+
+(defmethod registry-reindex ((db registry-db))
+ "Rebuild the secondary indices of registry-db THIS."
+ (let ((count 0)
+ (expected (* (length (oref db tracked)) (registry-size db))))
+ (dolist (tr (oref db tracked))
+ (let (values)
+ (maphash
+ (lambda (key v)
+ (incf count)
+ (when (and (< 0 expected)
+ (= 0 (mod count 1000)))
+ (message "reindexing: %d of %d (%.2f%%)"
+ count expected (/ (* 100.0 count) expected)))
+ (dolist (val (cdr-safe (assq tr v)))
+ (let* ((value-keys (registry-lookup-secondary-value db tr val)))
+ (push key value-keys)
+ (registry-lookup-secondary-value db tr val value-keys))))
+ (oref db data))))))
+
+(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
+ (floor (- (oref db max-size)
+ (* (oref db max-size)
+ (oref db prune-factor)))))
+ candidates)
+ (if (registry-full db)
+ (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))
+ (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)))
+ (cl-subseq (mapcar #'car candidates) 0 (min limit (length candidates)))))