-(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))
- "Prunes the registry-db object THIS.
-Removes 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))
- (size (registry-size db))
- (candidates (loop for k being the hash-keys of data
- using (hash-values v)
- when (notany precious-p v)
- collect k))
- (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)))
-
-(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))
-
-(ert-deftest registry-usage-test ()
- (let* ((n 100)
- (db (registry-make-testable-db n)))
- (message "size %d" n)
- (should (= n (registry-size db)))
- (message "max-hard test")
- (should-error (registry-insert db "new" '()))
- (message "Individual lookup")
- (should (= 58 (caadr (registry-lookup db '(1 58 99)))))
- (message "Grouped individual lookup")
- (should (= 3 (length (registry-lookup db '(1 58 99)))))
- (message "Search")
- (should (= n (length (registry-search db :all t))))
- (should (= n (length (registry-search db :member '((sender "me"))))))
- (message "Secondary index search")
- (should (= n (length (registry-lookup-secondary-value db 'sender "me"))))
- (should (equal '(74) (registry-lookup-secondary-value db 'groups "74")))
- (message "Delete")
- (should (registry-delete db '(1) t))
- (decf n)
- (message "Search after delete")
- (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 registry-persistence-test ()
- (let* ((n 100)
- (tempfile (make-temp-file "registry-persistence-"))
- (name "persistence tester")
- (db (registry-make-testable-db n name tempfile))
- size back)
- (message "Saving to %s" tempfile)
- (eieio-persistent-save db)
- (setq size (nth 7 (file-attributes tempfile)))
- (message "Saved to %s: size %d" tempfile size)
- (should (< 0 size))
- (with-temp-buffer
- (insert-file-contents-literally tempfile)
- (should (looking-at (concat ";; Object "
- name
- "\n;; EIEIO PERSISTENT OBJECT"))))
- (message "Reading object back")
- (setq back (eieio-persistent-read tempfile))
- (should back)
- (message "Read object back: %d keys, expected %d==%d"
- (registry-size back) n (registry-size db))
- (should (= (registry-size back) n))
- (should (= (registry-size back) (registry-size db)))
- (delete-file tempfile))
- (message "Done with persistence testing."))
+(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-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)))))