elfeed-db.el (25354B)
1 ;;; elfeed-db.el --- database and model for elfeed -*- lexical-binding: t; -*- 2 3 ;; This is free and unencumbered software released into the public domain. 4 5 ;;; Commentary: 6 7 ;; Elfeed is aware of two type of things: feeds and entries. All dates 8 ;; are stored as floating point epoch seconds. 9 10 ;; Feeds are keyed by their user-provided feed URL, which acts as the 11 ;; feed identity regardless of any other stated identity. Feeds have a 12 ;; list of entries. 13 14 ;; Entries are keyed in order of preference by id (Atom), guid (RSS), 15 ;; or link. To avoid circular references, entries refer to their 16 ;; parent feeds by URL. 17 18 ;; Feed content is stored in a content-addressable loose-file 19 ;; database, very similar to an unpacked Git object database. Entries 20 ;; have references to items in this database (elfeed-ref), keeping the 21 ;; actual entry struct memory footprint small. Most importantly, this 22 ;; keeps the core index small so that it can quickly be written as a 23 ;; whole to the filesystem. The wire format is just the s-expression 24 ;; print form of the top-level hash table. 25 26 ;; The database can be compacted into a small number of compressed 27 ;; files with the interactive function `elfeed-db-compact'. This could 28 ;; be used as a kill-emacs hook. 29 30 ;; An AVL tree containing all database entries ordered by date is 31 ;; maintained as part of the database. We almost always want to look 32 ;; at entries ordered by date and this step accomplished that very 33 ;; efficiently with the AVL tree. This is the reasoning behind the 34 ;; `with-elfeed-db-visit' interface. 35 36 ;; Unfortunately there's a nasty bug (bug#15190) in the reader that 37 ;; makes hash tables and `print-circle' incompatible. It's been fixed 38 ;; in trunk, but many users will likely be stuck with this bug for the 39 ;; next few years. This means the database format can't exploit 40 ;; circular references. 41 42 ;; Entry and feed objects can have arbitrary metadata attached, 43 ;; automatically stored in the database. The setf-able `elfeed-meta' 44 ;; function is used to access these. 45 46 ;;; Code: 47 48 (require 'cl-lib) 49 (require 'avl-tree) 50 (require 'elfeed-lib) 51 52 (defcustom elfeed-db-directory "~/.elfeed" 53 "Directory where elfeed will store its database." 54 :group 'elfeed 55 :type 'directory) 56 57 (defvar elfeed-db nil 58 "The core database for elfeed.") 59 60 (defvar elfeed-db-feeds nil 61 "Feeds hash table, part of `elfeed-db'.") 62 63 (defvar elfeed-db-entries nil 64 "Entries hash table, part of `elfeed-db'.") 65 66 (defvar elfeed-db-index nil 67 "Collection of all entries sorted by date, part of `elfeed-db'.") 68 69 (defvar elfeed-db-version 70 ;; If records are avaiable (Emacs 26), use the newer database format 71 (if (functionp 'record) 72 4 73 "0.0.3") 74 "The database version this version of Elfeed expects to use.") 75 76 (defvar elfeed-new-entry-hook () 77 "Functions in this list are called with the new entry as its argument. 78 This is a chance to add custom tags to new entries.") 79 80 (defvar elfeed-db-update-hook () 81 "Functions in this list are called with no arguments any time 82 the :last-update time is updated.") 83 84 (defvar elfeed-db-unload-hook () 85 "Hook to run immediately after `elfeed-db-unload'.") 86 87 ;; Data model: 88 89 (cl-defstruct (elfeed-feed (:constructor elfeed-feed--create)) 90 "A web feed, contains elfeed-entry structs." 91 id url title author meta) 92 93 (cl-defstruct (elfeed-entry (:constructor elfeed-entry--create)) 94 "A single entry from a feed, normalized towards Atom." 95 id title link date content content-type enclosures tags feed-id meta) 96 97 (defun elfeed-entry-merge (a b) 98 "Merge B into A, preserving A's tags. Return true if an actual 99 update occurred, not counting content." 100 (setf (elfeed-entry-tags b) (elfeed-entry-tags a) 101 (elfeed-entry-content a) (elfeed-entry-content b)) 102 (cl-loop for (key value) on (elfeed-entry-meta b) by #'cddr 103 do (setf (elfeed-entry-meta a) 104 (plist-put (elfeed-entry-meta a) key value))) 105 (not 106 (zerop 107 (cl-loop for i from 1 below (1- (length a)) 108 for part-a = (aref a i) 109 for part-b = (aref b i) 110 count (not (equal part-a part-b)) 111 do (setf (aref a i) part-b))))) 112 113 (defun elfeed-db-get-feed (id) 114 "Get/create the feed for ID." 115 (elfeed-db-ensure) 116 (let ((feed (gethash id elfeed-db-feeds))) 117 (or feed 118 (setf (gethash id elfeed-db-feeds) 119 (elfeed-feed--create :id id))))) 120 121 (defun elfeed-db-get-entry (id) 122 "Get the entry for ID." 123 (elfeed-db-ensure) 124 (gethash id elfeed-db-entries)) 125 126 (defun elfeed-db-compare (a b) 127 "Return true if entry A is newer than entry B." 128 (let* ((entry-a (elfeed-db-get-entry a)) 129 (entry-b (elfeed-db-get-entry b)) 130 (date-a (elfeed-entry-date entry-a)) 131 (date-b (elfeed-entry-date entry-b))) 132 (if (= date-a date-b) 133 (string< (prin1-to-string b) (prin1-to-string a)) 134 (> date-a date-b)))) 135 136 (defun elfeed-db-set-update-time () 137 "Update the database last-update time." 138 (setf elfeed-db (plist-put elfeed-db :last-update (float-time))) 139 (run-hooks 'elfeed-db-update-hook)) 140 141 (defun elfeed-db-add (entries) 142 "Add ENTRIES to the database." 143 (elfeed-db-ensure) 144 (cl-loop for entry in entries 145 for id = (elfeed-entry-id entry) 146 for original = (gethash id elfeed-db-entries) 147 for new-date = (elfeed-entry-date entry) 148 for original-date = (and original (elfeed-entry-date original)) 149 do (elfeed-deref-entry entry) 150 when original count 151 (if (= new-date original-date) 152 (elfeed-entry-merge original entry) 153 (avl-tree-delete elfeed-db-index id) 154 (prog1 (elfeed-entry-merge original entry) 155 (avl-tree-enter elfeed-db-index id))) 156 into change-count 157 else count 158 (setf (gethash id elfeed-db-entries) entry) 159 into change-count 160 and do 161 (progn 162 (avl-tree-enter elfeed-db-index id) 163 (cl-loop for hook in elfeed-new-entry-hook 164 do (funcall hook entry))) 165 finally 166 (unless (zerop change-count) 167 (elfeed-db-set-update-time))) 168 :success) 169 170 (defun elfeed-entry-feed (entry) 171 "Get the feed struct for ENTRY." 172 (elfeed-db-get-feed (elfeed-entry-feed-id entry))) 173 174 (defun elfeed-normalize-tags (tags &rest more-tags) 175 "Return the normalized tag list for TAGS." 176 (let ((all (apply #'append tags (nconc more-tags (list ()))))) 177 (cl-delete-duplicates (cl-sort all #'string< :key #'symbol-name)))) 178 179 (defun elfeed-tag-1 (entry &rest tags) 180 "Add TAGS to ENTRY." 181 (let ((current (elfeed-entry-tags entry))) 182 (setf (elfeed-entry-tags entry) 183 (elfeed-normalize-tags (append tags current))))) 184 185 (defun elfeed-untag-1 (entry &rest tags) 186 "Remove TAGS from ENTRY." 187 (setf (elfeed-entry-tags entry) 188 (cl-loop for tag in (elfeed-entry-tags entry) 189 unless (memq tag tags) collect tag))) 190 191 (defun elfeed-tag (entry-or-entry-list &rest tags) 192 "Add TAGS to ENTRY-OR-ENTRY-LIST and run `elfeed-tag-hooks'." 193 (let* ((entries (if (elfeed-entry-p entry-or-entry-list) 194 (list entry-or-entry-list) 195 entry-or-entry-list))) 196 (run-hook-with-args 'elfeed-tag-hooks entries tags) 197 (cl-loop for entry in entries do (apply #'elfeed-tag-1 entry tags)))) 198 199 (defun elfeed-untag (entry-or-entry-list &rest tags) 200 "Remove TAGS from ENTRY-OR-ENTRY-LIST and run `elfeed-untag-hooks'." 201 (let* ((entries (if (elfeed-entry-p entry-or-entry-list) 202 (list entry-or-entry-list) 203 entry-or-entry-list))) 204 (run-hook-with-args 'elfeed-untag-hooks entries tags) 205 (cl-loop for entry in entries do (apply #'elfeed-untag-1 entry tags)))) 206 207 (defun elfeed-tagged-p (tag entry) 208 "Return true if ENTRY is tagged by TAG." 209 (memq tag (elfeed-entry-tags entry))) 210 211 (defun elfeed-db-last-update () 212 "Return the last database update time in (`float-time') seconds." 213 (elfeed-db-ensure) 214 (or (plist-get elfeed-db :last-update) 0)) 215 216 (defmacro with-elfeed-db-visit (entry-and-feed &rest body) 217 "Visit each entry in the database from newest to oldest. 218 Use `elfeed-db-return' to exit early and optionally return data. 219 220 (with-elfeed-db-visit (entry feed) 221 (do-something entry) 222 (when (some-date-criteria-p entry) 223 (elfeed-db-return)))" 224 (declare (indent defun)) 225 `(catch 'elfeed-db-done 226 (prog1 nil 227 (elfeed-db-ensure) 228 (avl-tree-mapc 229 (lambda (id) 230 (let* ((,(cl-first entry-and-feed) (elfeed-db-get-entry id)) 231 (,(cl-second entry-and-feed) 232 (elfeed-entry-feed ,(cl-first entry-and-feed)))) 233 ,@body)) 234 elfeed-db-index)))) 235 236 (defun elfeed-feed-entries (feed-or-id) 237 "Return a list of all entries for a particular feed. 238 The FEED-OR-ID may be a feed struct or a feed ID (url)." 239 (let ((feed-id (if (elfeed-feed-p feed-or-id) 240 (elfeed-feed-id feed-or-id) 241 feed-or-id))) 242 (let ((entries)) 243 (with-elfeed-db-visit (entry feed) 244 (when (equal (elfeed-feed-id feed) feed-id) 245 (push entry entries))) 246 (nreverse entries)))) 247 248 (defun elfeed-apply-hooks-now () 249 "Apply `elfeed-new-entry-hook' to all entries in the database." 250 (interactive) 251 (with-elfeed-db-visit (entry _) 252 (cl-loop for hook in elfeed-new-entry-hook 253 do (funcall hook entry)))) 254 255 (defmacro elfeed-db-return (&optional value) 256 "Use this to exit early and return VALUE from `with-elfeed-db-visit'." 257 `(throw 'elfeed-db-done ,value)) 258 259 (defun elfeed-db-get-all-tags () 260 "Return a list of all tags currently in the database." 261 (let ((table (make-hash-table :test 'eq))) 262 (with-elfeed-db-visit (e _) 263 (dolist (tag (elfeed-entry-tags e)) 264 (setf (gethash tag table) tag))) 265 (let ((tags ())) 266 (maphash (lambda (k _) (push k tags)) table) 267 (cl-sort tags #'string< :key #'symbol-name)))) 268 269 ;; Saving and Loading: 270 271 (defun elfeed-db-save () 272 "Write the database index to the filesystem." 273 (elfeed-db-ensure) 274 (setf elfeed-db (plist-put elfeed-db :version elfeed-db-version)) 275 (mkdir elfeed-db-directory t) 276 (let ((coding-system-for-write 'utf-8)) 277 (with-temp-file (expand-file-name "index" elfeed-db-directory) 278 (let ((standard-output (current-buffer)) 279 (print-level nil) 280 (print-length nil) 281 (print-circle nil)) 282 (princ (format ";;; Elfeed Database Index (version %s)\n\n" 283 elfeed-db-version)) 284 (when (eql elfeed-db-version 4) 285 ;; Put empty dummy index in front 286 (princ ";; Dummy index for backwards compatablity:\n") 287 (prin1 (elfeed-db--dummy)) 288 (princ "\n\n;; Real index:\n")) 289 (prin1 elfeed-db) 290 :success)))) 291 292 (defun elfeed-db-save-safe () 293 "Run `elfeed-db-save' without triggering any errors, for use as a safe hook." 294 (ignore-errors (elfeed-db-save))) 295 296 (defun elfeed-db-upgrade (db) 297 "Upgrade the database from a previous format." 298 (if (not (vectorp (plist-get db :index))) 299 db ; Database is already in record format 300 (let* ((new-db (elfeed-db--empty)) 301 ;; Dynamically bind for other functions 302 (elfeed-db-feeds (plist-get new-db :feeds)) 303 (elfeed-db-entries (plist-get new-db :entries)) 304 (elfeed-db-index (plist-get new-db :index))) 305 ;; Fix up feeds 306 (cl-loop with table = (plist-get new-db :feeds) 307 for feed hash-values of (plist-get db :feeds) 308 for id = (aref feed 1) 309 for fixed = (elfeed-feed--create 310 :id id 311 :url (aref feed 2) 312 :title (aref feed 3) 313 :author (aref feed 4) 314 :meta (aref feed 5)) 315 do (setf (gethash id table) fixed)) 316 ;; Fix up entries 317 (cl-loop with table = (plist-get new-db :entries) 318 with index = (plist-get new-db :index) 319 for entry hash-values of (plist-get db :entries) 320 for id = (aref entry 1) 321 for content = (aref entry 5) 322 for fixed = (elfeed-entry--create 323 :id id 324 :title (aref entry 2) 325 :link (aref entry 3) 326 :date (aref entry 4) 327 :content (if (vectorp content) 328 (elfeed-ref--create 329 :id (aref content 1)) 330 content) 331 :content-type (aref entry 6) 332 :enclosures (aref entry 7) 333 :tags (aref entry 8) 334 :feed-id (aref entry 9) 335 :meta (aref entry 10)) 336 do (setf (gethash id table) fixed) 337 do (avl-tree-enter index id)) 338 (plist-put new-db :last-update (plist-get db :last-update))))) 339 340 (defun elfeed-db--empty () 341 "Create an empty database object." 342 `(:version ,elfeed-db-version 343 :feeds ,(make-hash-table :test 'equal) 344 :entries ,(make-hash-table :test 'equal) 345 ;; Compiler may warn about this (bug#15327): 346 :index ,(avl-tree-create #'elfeed-db-compare))) 347 348 (defun elfeed-db--dummy () 349 "Create an empty dummy database for Emacs 25 and earlier." 350 (list :version "0.0.3" 351 :feeds #s(hash-table size 65 352 test equal 353 rehash-size 1.5 354 rehash-threshold 0.8 355 data ()) 356 :entries #s(hash-table size 65 357 test equal 358 rehash-size 1.5 359 rehash-threshold 0.8 360 data ()) 361 :index [cl-struct-avl-tree- [nil nil nil 0] elfeed-db-compare])) 362 363 ;; To cope with the incompatible struct changes in Emacs 26, Elfeed 364 ;; uses version 4 of the database format when run under Emacs 26. This 365 ;; version saves a dummy, empty index in front of the real database. A 366 ;; user going from Emacs 26 to Emacs 25 will quietly load an empty 367 ;; index since it's unreasonable to downgrade (would require rewriting 368 ;; the Emacs reader from scratch). 369 370 (defun elfeed-db-load () 371 "Load the database index from the filesystem." 372 (let ((index (expand-file-name "index" elfeed-db-directory)) 373 (enable-local-variables nil)) ; don't set local variables from index! 374 (if (not (file-exists-p index)) 375 (setf elfeed-db (elfeed-db--empty)) 376 ;; Override the default value for major-mode. There is no 377 ;; preventing find-file-noselect from starting the default major 378 ;; mode while also having it handle buffer conversion. Some 379 ;; major modes crash Emacs when enabled in large buffers (e.g. 380 ;; org-mode). This includes the Elfeed index, so we must not let 381 ;; this happen. 382 (cl-letf (((default-value 'major-mode) 'fundamental-mode)) 383 (with-current-buffer (find-file-noselect index :nowarn) 384 (goto-char (point-min)) 385 (if (eql elfeed-db-version 4) 386 ;; May need to skip over dummy database 387 (let ((db-1 (read (current-buffer))) 388 (db-2 (ignore-errors (read (current-buffer))))) 389 (setf elfeed-db (or db-2 db-1))) 390 ;; Just load first database 391 (setf elfeed-db (read (current-buffer)))) 392 (kill-buffer)))) 393 ;; Perform an upgrade if necessary and possible 394 (unless (equal (plist-get elfeed-db :version) elfeed-db-version) 395 (ignore-errors 396 (copy-file index (concat index ".backup"))) 397 (message "Upgrading Elfeed index for Emacs 26 ...") 398 (setf elfeed-db (elfeed-db-upgrade elfeed-db)) 399 (message "Elfeed index upgrade complete.")) 400 (setf elfeed-db-feeds (plist-get elfeed-db :feeds) 401 elfeed-db-entries (plist-get elfeed-db :entries) 402 elfeed-db-index (plist-get elfeed-db :index) 403 ;; Internal function use required for security! 404 (avl-tree--cmpfun elfeed-db-index) #'elfeed-db-compare))) 405 406 (defun elfeed-db-unload () 407 "Unload the database so that it can be operated on externally. 408 409 Runs `elfeed-db-unload-hook' after unloading the database." 410 (interactive) 411 (elfeed-db-save) 412 (setf elfeed-db nil 413 elfeed-db-feeds nil 414 elfeed-db-entries nil 415 elfeed-db-index nil) 416 (run-hooks 'elfeed-db-unload-hook)) 417 418 (defun elfeed-db-ensure () 419 "Ensure that the database has been loaded." 420 (when (null elfeed-db) (elfeed-db-load))) 421 422 (defun elfeed-db-size () 423 "Return a count of the number of entries in the database." 424 (let ((count-table (hash-table-count elfeed-db-entries)) 425 (count-tree (avl-tree-size elfeed-db-index))) 426 (if (= count-table count-tree) 427 count-table 428 (error "Elfeed database error: entry count mismatch.")))) 429 430 ;; Metadata: 431 432 (defun elfeed-meta--plist (thing) 433 "Get the metadata plist for THING." 434 (cl-typecase thing 435 (elfeed-feed (elfeed-feed-meta thing)) 436 (elfeed-entry (elfeed-entry-meta thing)) 437 (otherwise (error "Don't know how to access metadata on %S" thing)))) 438 439 (defun elfeed-meta--set-plist (thing plist) 440 "Set the metadata plist on THING to PLIST." 441 (cl-typecase thing 442 (elfeed-feed (setf (elfeed-feed-meta thing) plist)) 443 (elfeed-entry (setf (elfeed-entry-meta thing) plist)) 444 (otherwise (error "Don't know how to access metadata on %S" thing)))) 445 446 (defun elfeed-db--plist-fixup (plist) 447 "Remove nil values from PLIST." 448 (cl-loop for (k v) on plist by #'cddr 449 when (not (null v)) 450 collect k and collect v)) 451 452 (defun elfeed-meta (thing key &optional default) 453 "Access metadata for THING (entry, feed) under KEY." 454 (or (plist-get (elfeed-meta--plist thing) key) 455 default)) 456 457 (defun elfeed-meta--put (thing key value) 458 "Set metadata to VALUE on THING under KEY." 459 (when (not (elfeed-readable-p value)) (error "New value must be readable.")) 460 (let ((new-plist (plist-put (elfeed-meta--plist thing) key value))) 461 (prog1 value 462 (elfeed-meta--set-plist thing (elfeed-db--plist-fixup new-plist))))) 463 464 (gv-define-setter elfeed-meta (value thing key &optional _default) 465 `(elfeed-meta--put ,thing ,key ,value)) 466 467 ;; Filesystem storage: 468 469 (defvar elfeed-ref-archive nil 470 "Index of archived/packed content.") 471 472 (defvar elfeed-ref-cache nil 473 "Temporary storage of the full archive content.") 474 475 (cl-defstruct (elfeed-ref (:constructor elfeed-ref--create)) 476 id) 477 478 (defun elfeed-ref--file (ref) 479 "Determine the storage filename for REF." 480 (let* ((id (elfeed-ref-id ref)) 481 (root (expand-file-name "data" elfeed-db-directory)) 482 (subdir (expand-file-name (substring id 0 2) root))) 483 (expand-file-name id subdir))) 484 485 (cl-defun elfeed-ref-archive-filename (&optional (suffix "")) 486 "Return the base filename of the archive files." 487 (concat (expand-file-name "data/archive" elfeed-db-directory) suffix)) 488 489 (defun elfeed-ref-archive-load () 490 "Load the archived ref index." 491 (let ((archive-index (elfeed-ref-archive-filename ".index"))) 492 (if (file-exists-p archive-index) 493 (with-temp-buffer 494 (insert-file-contents archive-index) 495 (setf elfeed-ref-archive (read (current-buffer)))) 496 (setf elfeed-ref-archive :empty)))) 497 498 (defun elfeed-ref-archive-ensure () 499 "Ensure that the archive index is loaded." 500 (when (null elfeed-ref-archive) (elfeed-ref-archive-load))) 501 502 (defun elfeed-ref-exists-p (ref) 503 "Return true if REF can be dereferenced." 504 (elfeed-ref-archive-ensure) 505 (or (and (hash-table-p elfeed-ref-archive) 506 (not (null (gethash (elfeed-ref-id ref) elfeed-ref-archive)))) 507 (file-exists-p (elfeed-ref--file ref)))) 508 509 (defun elfeed-deref (ref) 510 "Fetch the content behind the reference, or nil if non-existent." 511 (elfeed-ref-archive-ensure) 512 (if (not (elfeed-ref-p ref)) 513 ref 514 (let ((index (and (hash-table-p elfeed-ref-archive) 515 (gethash (elfeed-ref-id ref) elfeed-ref-archive))) 516 (archive-file (elfeed-ref-archive-filename ".gz")) 517 (coding-system-for-read 'utf-8)) 518 (if (and index (file-exists-p archive-file)) 519 (progn 520 (when (null elfeed-ref-cache) 521 (with-temp-buffer 522 (insert-file-contents archive-file) 523 (setf elfeed-ref-cache (buffer-string))) 524 ;; Clear cache on next turn. 525 (run-at-time 0 nil (lambda () (setf elfeed-ref-cache nil)))) 526 (substring elfeed-ref-cache (car index) (cdr index))) 527 (let ((file (elfeed-ref--file ref))) 528 (when (file-exists-p file) 529 (with-temp-buffer 530 (insert-file-contents file) 531 (buffer-string)))))))) 532 533 (defun elfeed-ref (content) 534 "Create a reference to CONTENT, to be persistently stored." 535 (if (elfeed-ref-p content) 536 content 537 (let* ((id (secure-hash 'sha1 (encode-coding-string content 'utf-8 t))) 538 (ref (elfeed-ref--create :id id)) 539 (file (elfeed-ref--file ref))) 540 (prog1 ref 541 (unless (elfeed-ref-exists-p ref) 542 (mkdir (file-name-directory file) t) 543 (let ((coding-system-for-write 'utf-8) 544 ;; Content data loss is a tolerable risk. 545 ;; Fsync will occur soon on index write anyway. 546 (write-region-inhibit-fsync t)) 547 (with-temp-file file 548 (insert content)))))))) 549 550 (defun elfeed-deref-entry (entry) 551 "Move ENTRY's content to filesystem storage. Return the entry." 552 (let ((content (elfeed-entry-content entry))) 553 (prog1 entry 554 (when (stringp content) 555 (setf (elfeed-entry-content entry) (elfeed-ref content)))))) 556 557 (defun elfeed-ref-delete (ref) 558 "Remove the content behind REF from the database." 559 (ignore-errors 560 (delete-file (elfeed-ref--file ref)))) 561 562 (defun elfeed-db-gc-empty-feeds () 563 "Remove feeds with no entries from the database." 564 (let ((seen (make-hash-table :test 'equal))) 565 (with-elfeed-db-visit (entry feed) 566 (setf (gethash (elfeed-feed-id feed) seen) feed)) 567 (maphash (lambda (id _) 568 (unless (gethash id seen) 569 (remhash id elfeed-db-feeds))) 570 elfeed-db-feeds))) 571 572 (defun elfeed-db-gc (&optional stats-p) 573 "Clean up unused content from the content database. 574 If STATS is true, return the space cleared in bytes." 575 (elfeed-db-gc-empty-feeds) 576 (let* ((data (expand-file-name "data" elfeed-db-directory)) 577 (dirs (directory-files data t "^[0-9a-z]\\{2\\}$")) 578 (ids (cl-mapcan (lambda (d) (directory-files d nil nil t)) dirs)) 579 (table (make-hash-table :test 'equal))) 580 (dolist (id ids) 581 (setf (gethash id table) nil)) 582 (with-elfeed-db-visit (entry _) 583 (let ((content (elfeed-entry-content entry))) 584 (when (elfeed-ref-p content) 585 (setf (gethash (elfeed-ref-id content) table) t)))) 586 (cl-loop for id hash-keys of table using (hash-value used) 587 for used-p = (or used (member id '("." ".."))) 588 when (and (not used-p) stats-p) 589 sum (let* ((ref (elfeed-ref--create :id id)) 590 (file (elfeed-ref--file ref))) 591 (* 1.0 (nth 7 (file-attributes file)))) 592 unless used-p 593 do (elfeed-ref-delete (elfeed-ref--create :id id)) 594 finally (cl-loop for dir in dirs 595 when (elfeed-directory-empty-p dir) 596 do (delete-directory dir))))) 597 598 (defun elfeed-db-pack () 599 "Pack all content into a single archive for efficient storage." 600 (let ((coding-system-for-write 'utf-8) 601 (next-archive (make-hash-table :test 'equal)) 602 (packed ())) 603 (make-directory (expand-file-name "data" elfeed-db-directory) t) 604 (with-temp-file (elfeed-ref-archive-filename ".gz") 605 (with-elfeed-db-visit (entry _) 606 (let ((ref (elfeed-entry-content entry)) 607 (start (1- (point)))) 608 (when (elfeed-ref-p ref) 609 (let ((content (elfeed-deref ref))) 610 (when content 611 (push ref packed) 612 (insert content) 613 (setf (gethash (elfeed-ref-id ref) next-archive) 614 (cons start (1- (point)))))))))) 615 (with-temp-file (elfeed-ref-archive-filename ".index") 616 (let ((standard-output (current-buffer)) 617 (print-level nil) 618 (print-length nil) 619 (print-circle nil)) 620 (prin1 next-archive))) 621 (setf elfeed-ref-cache nil) 622 (setf elfeed-ref-archive next-archive) 623 (mapc #'elfeed-ref-delete packed) 624 :success)) 625 626 (defun elfeed-db-compact () 627 "Minimize the Elfeed database storage size on the filesystem. 628 This requires that auto-compression-mode can handle 629 gzip-compressed files, so the gzip program must be in your PATH." 630 (interactive) 631 (unless (elfeed-gzip-supported-p) 632 (error "aborting compaction: gzip auto-compression-mode unsupported")) 633 (elfeed-db-pack) 634 (elfeed-db-gc)) 635 636 (defun elfeed-db-gc-safe () 637 "Run `elfeed-db-gc' without triggering any errors, for use as a safe hook." 638 (ignore-errors (elfeed-db-gc))) 639 640 (unless noninteractive 641 (add-hook 'kill-emacs-hook #'elfeed-db-gc-safe :append) 642 (add-hook 'kill-emacs-hook #'elfeed-db-save-safe)) 643 644 (provide 'elfeed-db) 645 646 ;;; elfeed-db.el ends here