├── Keg ├── Makefile ├── .github └── workflows │ └── test.yml ├── README.md ├── test └── pcache-test.el └── pcache.el /Keg: -------------------------------------------------------------------------------- 1 | ;; Keg 2 | 3 | (source gnu melpa) 4 | 5 | (package 6 | (pcache 7 | (recipe . (pcache :fetcher github :repo "sigma/pcache")))) 8 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | EMACS ?= emacs 2 | 3 | .PHONY: build test clean 4 | 5 | build: 6 | keg build 7 | 8 | test: 9 | keg exec $(EMACS) --batch -l test/pcache-test.el -f ert-run-tests-batch-and-exit 10 | 11 | clean: 12 | keg clean 13 | -------------------------------------------------------------------------------- /.github/workflows/test.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | on: 3 | push: {branches: [master]} 4 | pull_request: {branches: [master]} 5 | 6 | jobs: 7 | test: 8 | runs-on: ubuntu-latest 9 | strategy: 10 | fail-fast: false 11 | matrix: 12 | emacs_version: 13 | - '25.1' 14 | - '25.2' 15 | - '25.3' 16 | - '26.1' 17 | - '26.2' 18 | - '26.3' 19 | - '27.1' 20 | - '27.2' 21 | - '28.1' 22 | - 'snapshot' 23 | include: 24 | - emacs_version: 'snapshot' 25 | allow_failure: true 26 | steps: 27 | - uses: actions/checkout@v1 28 | - uses: purcell/setup-emacs@master 29 | with: 30 | version: ${{ matrix.emacs_version }} 31 | - uses: conao3/setup-keg@master 32 | 33 | - name: Run tests 34 | if: matrix.allow_failure != true 35 | run: 'make test' 36 | 37 | - name: Run tests (allow failure) 38 | if: matrix.allow_failure == true 39 | run: 'make test || true' 40 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ![Build Status](https://github.com/sigma/pcache/workflows/CI/badge.svg?branch=master) 2 | 3 | ## Pcache 4 | 5 | pcache provides a persistent way of caching data, in a hashtable-like 6 | structure. It relies on `eieio-persistent' in the backend, so that any 7 | object that can be serialized by EIEIO can be stored with pcache. 8 | 9 | pcache handles objects called "repositories" (`pcache-repository`) and 10 | "entries" (`pcache-entry`). Each repository is identified by a unique name, 11 | that defines an entry in `pcache-directory`. Subdirectories are allowed, by 12 | the use of a directory separator in the repository name. 13 | 14 | Example: 15 | 16 | ```lisp 17 | (let ((repo (pcache-repository "plop"))) 18 | (pcache-put repo 'foo 42) ; store value 42 with key 'foo 19 | (pcache-get repo 'foo) ; => 42 20 | ) 21 | ``` 22 | 23 | Keys can be pretty much any Lisp object, and are compared for equality using 24 | `eql` 25 | 26 | Optionally, cache entries can expire: 27 | 28 | ```lisp 29 | (let ((repo (pcache-repository "plop"))) 30 | (pcache-put repo 'foo 42 1) ; store value 42 with key 'foo for 1 second 31 | (sleep-for 1) 32 | (pcache-get repo 'foo) ; => nil 33 | ) 34 | ``` 35 | -------------------------------------------------------------------------------- /test/pcache-test.el: -------------------------------------------------------------------------------- 1 | ;;; pcache-test.el --- tests for pcache.el 2 | 3 | ;; Copyright (C) 2011 Yann Hodique 4 | 5 | ;; Author: Yann Hodique 6 | 7 | ;; This file is free software; you can redistribute it and/or modify 8 | ;; it under the terms of the GNU General Public License as published by 9 | ;; the Free Software Foundation; either version 2, or (at your option) 10 | ;; any later version. 11 | 12 | ;; This file is distributed in the hope that it will be useful, 13 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | ;; GNU General Public License for more details. 16 | 17 | ;; You should have received a copy of the GNU General Public License 18 | ;; along with GNU Emacs; see the file COPYING. If not, write to 19 | ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, 20 | ;; Boston, MA 02111-1307, USA. 21 | 22 | ;;; Commentary: 23 | 24 | ;; 25 | 26 | ;;; Code: 27 | 28 | (require 'ert) 29 | (require 'pcache) 30 | 31 | (defmacro pcache-with-repository (var arglist &rest body) 32 | (declare (indent 2) (debug t)) 33 | `(let ((,var (apply pcache-repository ',arglist))) 34 | (unwind-protect 35 | (progn 36 | ,@body) 37 | (pcache-destroy-repository ,(car arglist))))) 38 | 39 | (ert-deftest pcache-create-repo () 40 | (pcache-with-repository repo ("pcache-test/tmp") 41 | (should (object-of-class-p repo 'pcache-repository)))) 42 | 43 | (ert-deftest pcache-double-destroy () 44 | (pcache-with-repository repo ("pcache-test/tmp") 45 | (pcache-destroy-repository "pcache-test/tmp"))) 46 | 47 | (ert-deftest pcache-put-get () 48 | (pcache-with-repository repo ("pcache-test/tmp") 49 | (pcache-put repo 'foo 42) 50 | (should (eq 42 (pcache-get repo 'foo))))) 51 | 52 | (ert-deftest pcache-validate-simple () 53 | (pcache-with-repository repo ("pcache-test/tmp") 54 | (pcache-put repo 'foo 42) 55 | (should (pcache-validate-repo repo)))) 56 | 57 | (ert-deftest pcache-get-expired () 58 | (pcache-with-repository repo ("pcache-test/tmp") 59 | (pcache-put repo 'foo 42 1) 60 | (should (eq 42 (pcache-get repo 'foo))) 61 | (sleep-for 1) 62 | (should (null (pcache-get repo 'foo))))) 63 | 64 | (ert-deftest pcache-get-invalidated () 65 | (pcache-with-repository repo ("pcache-test/tmp") 66 | (pcache-put repo 'foo 42) 67 | (should (eq 42 (pcache-get repo 'foo))) 68 | (pcache-invalidate repo 'foo) 69 | (should (null (pcache-get repo 'foo))))) 70 | 71 | (ert-deftest pcache-put-reload-get () 72 | (pcache-with-repository repo ("pcache-test/tmp1") 73 | (pcache-put repo 'foo 44) 74 | (pcache-save repo t) 75 | (with-current-buffer 76 | (find-file-noselect (concat pcache-directory "pcache-test/tmp1")) 77 | (goto-char (point-min)) 78 | (while (search-forward "tmp1" nil t) 79 | (replace-match "tmp2")) 80 | (write-file (concat pcache-directory "pcache-test/tmp2")))) 81 | (pcache-with-repository repo ("pcache-test/tmp2") 82 | (should (eq 44 (pcache-get repo 'foo))))) 83 | 84 | (provide 'pcache-test) 85 | ;;; pcache-test.el ends here 86 | -------------------------------------------------------------------------------- /pcache.el: -------------------------------------------------------------------------------- 1 | ;;; pcache.el --- persistent caching for Emacs. -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2011-2020 Yann Hodique 4 | 5 | ;; Author: Yann Hodique 6 | ;; Keywords: extensions 7 | ;; Version: 0.5.1 8 | ;; Package-Requires: ((emacs "25.1")) 9 | 10 | ;; This file is free software; you can redistribute it and/or modify 11 | ;; it under the terms of the GNU General Public License as published by 12 | ;; the Free Software Foundation; either version 2, or (at your option) 13 | ;; any later version. 14 | 15 | ;; This file is distributed in the hope that it will be useful, 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 | ;; GNU General Public License for more details. 19 | 20 | ;; You should have received a copy of the GNU General Public License 21 | ;; along with GNU Emacs; see the file COPYING. If not, write to 22 | ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, 23 | ;; Boston, MA 02111-1307, USA. 24 | 25 | ;;; Commentary: 26 | 27 | ;; pcache provides a persistent way of caching data, in a hashtable-like 28 | ;; structure. It relies on `eieio-persistent' in the backend, so that any 29 | ;; object that can be serialized by EIEIO can be stored with pcache. 30 | 31 | ;; pcache handles objects called "repositories" (`pcache-repository') and 32 | ;; "entries" (`pcache-entry'). Each repository is identified by a unique name, 33 | ;; that defines an entry in `pcache-directory'. Subdirectories are allowed, by 34 | ;; the use of a directory separator in the repository name. 35 | 36 | ;; Example: 37 | ;; (let ((repo (pcache-repository "plop"))) 38 | ;; (pcache-put repo 'foo 42) ; store value 42 with key 'foo 39 | ;; (pcache-get repo 'foo) ; => 42 40 | ;; ) 41 | 42 | ;; Keys can be pretty much any Lisp object, and are compared for equality using 43 | ;; `eql' 44 | 45 | ;; Optionally, cache entries can expire: 46 | ;; (let ((repo (pcache-repository "plop"))) 47 | ;; (pcache-put repo 'foo 42 1) ; store value 42 with key 'foo for 1 second 48 | ;; (sleep-for 1) 49 | ;; (pcache-get repo 'foo) ; => nil 50 | ;; ) 51 | 52 | ;;; Code: 53 | 54 | (require 'cl-lib) 55 | (require 'cl-extra) 56 | (require 'eieio) 57 | (require 'eieio-base) 58 | 59 | (defvar pcache-directory (concat user-emacs-directory "var/pcache/")) 60 | 61 | (defvar *pcache-repositories* (make-hash-table :test 'equal)) 62 | 63 | (defvar pcache-avoid-recursion nil) 64 | 65 | (defconst pcache-default-save-delay 300) 66 | 67 | (defconst pcache-internal-version-constant "0.5") 68 | 69 | (defconst pcache-version-constant 70 | (format "%s/%s" emacs-version pcache-internal-version-constant)) 71 | 72 | (defclass pcache-repository (eieio-persistent eieio-named) 73 | ((version :initarg :version :initform nil) 74 | (version-constant :allocation :class) 75 | (entries :initarg :entries :initform (make-hash-table)) 76 | (entry-cls :initarg :entry-cls :initform pcache-entry) 77 | (timestamp :initarg :timestamp :initform (float-time (current-time))) 78 | (save-delay :initarg :save-delay))) 79 | 80 | (oset-default 'pcache-repository :save-delay pcache-default-save-delay) 81 | (oset-default 'pcache-repository version-constant pcache-version-constant) 82 | 83 | (defvar *pcache-repository-name* nil) 84 | 85 | (cl-defmethod make-instance ((cls (subclass pcache-repository)) &rest args) 86 | (let* ((newname (or (and (stringp (car args)) (car args)) 87 | (plist-get args :object-name) 88 | *pcache-repository-name* 89 | (symbol-name cls))) 90 | (e (gethash newname *pcache-repositories*)) 91 | (path (concat pcache-directory newname))) 92 | (setq args (append args (list :object-name newname))) 93 | (or e 94 | (and (not pcache-avoid-recursion) 95 | (file-exists-p path) 96 | (condition-case nil 97 | (let* ((pcache-avoid-recursion t) 98 | (*pcache-repository-name* newname) 99 | (obj (eieio-persistent-read path 'pcache-repository t))) 100 | (and (or (pcache-validate-repo obj) 101 | (error "wrong version")) 102 | (puthash newname obj *pcache-repositories*) 103 | obj)) 104 | (error nil))) 105 | (let ((obj (cl-call-next-method)) 106 | (dir (file-name-directory path))) 107 | (unless (file-exists-p dir) 108 | (make-directory dir t)) 109 | (oset obj :file path) 110 | (oset obj :version (oref-default obj version-constant)) 111 | (puthash newname obj *pcache-repositories*) 112 | obj)))) 113 | 114 | (defun pcache-hash-table-values (h) 115 | (let (values) 116 | (maphash (lambda (k v) (push v values)) h) 117 | values)) 118 | 119 | ;; force custom implementation. 120 | (cl-defmethod pcache-validate-repo ((cache t)) 121 | nil) 122 | 123 | (cl-defmethod pcache-validate-repo ((cache pcache-repository)) 124 | (and 125 | (equal (oref cache version) 126 | (oref-default (eieio-object-class cache) version-constant)) 127 | (hash-table-p (oref cache entries)) 128 | (cl-every 129 | (function 130 | (lambda (entry) 131 | (and (object-of-class-p entry (oref cache entry-cls)) 132 | (pcache-validate-entry entry)))) 133 | (pcache-hash-table-values (oref cache entries))))) 134 | 135 | (defclass pcache-entry () 136 | ((timestamp :initarg :timestamp 137 | :initform (float-time (current-time))) 138 | (ttl :initarg :ttl :initform nil) 139 | (value :initarg :value :initform nil) 140 | (value-cls :initarg :value-cls :initform nil))) 141 | 142 | ;; force custom implementation. 143 | (cl-defmethod pcache-validate-entry ((entry t)) 144 | nil) 145 | 146 | (cl-defmethod pcache-validate-entry ((entry pcache-entry)) 147 | (or (null (oref entry value-cls)) 148 | (object-of-class-p 149 | (oref entry value) (oref entry value-cls)))) 150 | 151 | (cl-defmethod pcache-entry-valid-p ((entry pcache-entry)) 152 | (let ((ttl (oref entry ttl))) 153 | (or (null ttl) 154 | (let ((time (float-time (current-time)))) 155 | (< time (+ ttl (oref entry timestamp))))))) 156 | 157 | (cl-defmethod pcache-get ((cache pcache-repository) key &optional default) 158 | (let* ((table (oref cache entries)) 159 | (entry (gethash key table))) 160 | (if entry 161 | (if (pcache-entry-valid-p entry) 162 | (oref entry value) 163 | (remhash key table) 164 | default) 165 | default))) 166 | 167 | (cl-defmethod pcache-has ((cache pcache-repository) key) 168 | (let* ((default (make-symbol ":nil")) 169 | (table (oref cache entries)) 170 | (entry (gethash key table default))) 171 | (if (eq entry default) nil 172 | (if (pcache-entry-valid-p entry) 173 | t nil)))) 174 | 175 | (cl-defmethod pcache-put ((cache pcache-repository) key value &optional ttl) 176 | (let ((table (oref cache entries)) 177 | (entry (or (and (eieio-object-p value) 178 | (object-of-class-p value 'pcache-entry) 179 | value) 180 | (make-instance 181 | (oref cache entry-cls) 182 | :value value 183 | :value-cls (and (eieio-object-p value) (eieio-object-class value)))))) 184 | (when ttl 185 | (oset entry :ttl ttl)) 186 | (prog1 187 | (puthash key entry table) 188 | (pcache-save cache)))) 189 | 190 | (cl-defmethod pcache-invalidate ((cache pcache-repository) key) 191 | (let ((table (oref cache entries))) 192 | (remhash key table) 193 | (pcache-save cache))) 194 | 195 | (cl-defmethod pcache-clear ((cache pcache-repository)) 196 | (let* ((entries (oref cache entries)) 197 | (test (hash-table-test entries)) 198 | (resize (hash-table-rehash-size entries)) 199 | (threshold (hash-table-rehash-threshold entries)) 200 | (weakness (hash-table-weakness entries))) 201 | (oset cache :entries (make-hash-table :test test :rehash-size resize 202 | :rehash-threshold threshold 203 | :weakness weakness))) 204 | (pcache-save cache)) 205 | 206 | (cl-defmethod pcache-purge-invalid ((cache pcache-repository)) 207 | (let ((table (oref cache entries))) 208 | (maphash (lambda (k e) 209 | (unless (pcache-entry-valid-p e) 210 | (remhash k table))) 211 | table) 212 | (pcache-save cache))) 213 | 214 | (cl-defmethod pcache-save ((cache pcache-repository) &optional force) 215 | (let ((timestamp (oref cache timestamp)) 216 | (delay (oref cache save-delay)) 217 | (time (float-time (current-time)))) 218 | (when (or force (> time (+ timestamp delay))) 219 | (oset cache :timestamp time) 220 | ;; make sure version is saved to file 221 | (oset cache :version (oref-default (eieio-object-class cache) version-constant)) 222 | (eieio-persistent-save cache)))) 223 | 224 | (cl-defmethod pcache-map ((cache pcache-repository) func) 225 | (let ((table (oref cache entries))) 226 | (maphash func table))) 227 | 228 | (defun pcache-kill-emacs-hook () 229 | (maphash (lambda (k v) 230 | (condition-case nil 231 | (pcache-purge-invalid v) 232 | (error nil)) 233 | (condition-case nil 234 | (pcache-save v t) 235 | (error nil))) 236 | *pcache-repositories*)) 237 | 238 | (defun pcache-destroy-repository (name) 239 | (remhash name *pcache-repositories*) 240 | (let ((fname (concat pcache-directory name))) 241 | (when (file-exists-p fname) 242 | (delete-file fname)))) 243 | 244 | (add-hook 'kill-emacs-hook #'pcache-kill-emacs-hook) 245 | 246 | ;; in case we reload in place, clean all repositories with invalid version 247 | (let (to-clean) 248 | (maphash (lambda (k v) 249 | (condition-case nil 250 | (unless (eql (oref v version) 251 | pcache-version-constant) 252 | (signal 'error nil)) 253 | (error 254 | (setq to-clean (cons k to-clean))))) 255 | *pcache-repositories*) 256 | (dolist (k to-clean) 257 | (remhash k *pcache-repositories*))) 258 | 259 | (provide 'pcache) 260 | ;;; pcache.el ends here 261 | --------------------------------------------------------------------------------