--- /dev/null
+;;; pcache.el --- persistent caching for Emacs. -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2011-2020 Yann Hodique
+
+;; Author: Yann Hodique <yann.hodiqueNOSPAMgmail.com>
+;; Keywords: extensions
+;; Package-Version: 20220724.1841
+;; Package-Commit: cae29ddbc3d12fac18ab5cfc26fa3ef13eb97dad
+;; Version: 0.5.1
+;; Package-Requires: ((emacs "25.1"))
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; pcache provides a persistent way of caching data, in a hashtable-like
+;; structure. It relies on `eieio-persistent' in the backend, so that any
+;; object that can be serialized by EIEIO can be stored with pcache.
+
+;; pcache handles objects called "repositories" (`pcache-repository') and
+;; "entries" (`pcache-entry'). Each repository is identified by a unique name,
+;; that defines an entry in `pcache-directory'. Subdirectories are allowed, by
+;; the use of a directory separator in the repository name.
+
+;; Example:
+;; (let ((repo (pcache-repository "plop")))
+;; (pcache-put repo 'foo 42) ; store value 42 with key 'foo
+;; (pcache-get repo 'foo) ; => 42
+;; )
+
+;; Keys can be pretty much any Lisp object, and are compared for equality using
+;; `eql'
+
+;; Optionally, cache entries can expire:
+;; (let ((repo (pcache-repository "plop")))
+;; (pcache-put repo 'foo 42 1) ; store value 42 with key 'foo for 1 second
+;; (sleep-for 1)
+;; (pcache-get repo 'foo) ; => nil
+;; )
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'cl-extra)
+(require 'eieio)
+(require 'eieio-base)
+
+(defvar pcache-directory (concat user-emacs-directory "var/pcache/"))
+
+(defvar *pcache-repositories* (make-hash-table :test 'equal))
+
+(defvar pcache-avoid-recursion nil)
+
+(defconst pcache-default-save-delay 300)
+
+(defconst pcache-internal-version-constant "0.5")
+
+(defconst pcache-version-constant
+ (format "%s/%s" emacs-version pcache-internal-version-constant))
+
+(defclass pcache-repository (eieio-persistent eieio-named)
+ ((version :initarg :version :initform nil)
+ (version-constant :allocation :class)
+ (entries :initarg :entries :initform (make-hash-table))
+ (entry-cls :initarg :entry-cls :initform pcache-entry)
+ (timestamp :initarg :timestamp :initform (float-time (current-time)))
+ (save-delay :initarg :save-delay)))
+
+(oset-default 'pcache-repository :save-delay pcache-default-save-delay)
+(oset-default 'pcache-repository version-constant pcache-version-constant)
+
+(defvar *pcache-repository-name* nil)
+
+(cl-defmethod make-instance ((cls (subclass pcache-repository)) &rest args)
+ (let* ((newname (or (and (stringp (car args)) (car args))
+ (plist-get args :object-name)
+ *pcache-repository-name*
+ (symbol-name cls)))
+ (e (gethash newname *pcache-repositories*))
+ (path (concat pcache-directory newname)))
+ (setq args (append args (list :object-name newname)))
+ (or e
+ (and (not pcache-avoid-recursion)
+ (file-exists-p path)
+ (condition-case nil
+ (let* ((pcache-avoid-recursion t)
+ (*pcache-repository-name* newname)
+ (obj (eieio-persistent-read path 'pcache-repository t)))
+ (and (or (pcache-validate-repo obj)
+ (error "wrong version"))
+ (puthash newname obj *pcache-repositories*)
+ obj))
+ (error nil)))
+ (let ((obj (cl-call-next-method))
+ (dir (file-name-directory path)))
+ (unless (file-exists-p dir)
+ (make-directory dir t))
+ (oset obj :file path)
+ (oset obj :version (oref-default obj version-constant))
+ (puthash newname obj *pcache-repositories*)
+ obj))))
+
+(defun pcache-hash-table-values (h)
+ (let (values)
+ (maphash (lambda (k v) (push v values)) h)
+ values))
+
+;; force custom implementation.
+(cl-defmethod pcache-validate-repo ((cache t))
+ nil)
+
+(cl-defmethod pcache-validate-repo ((cache pcache-repository))
+ (and
+ (equal (oref cache version)
+ (oref-default (eieio-object-class cache) version-constant))
+ (hash-table-p (oref cache entries))
+ (cl-every
+ (function
+ (lambda (entry)
+ (and (object-of-class-p entry (oref cache entry-cls))
+ (pcache-validate-entry entry))))
+ (pcache-hash-table-values (oref cache entries)))))
+
+(defclass pcache-entry ()
+ ((timestamp :initarg :timestamp
+ :initform (float-time (current-time)))
+ (ttl :initarg :ttl :initform nil)
+ (value :initarg :value :initform nil)
+ (value-cls :initarg :value-cls :initform nil)))
+
+;; force custom implementation.
+(cl-defmethod pcache-validate-entry ((entry t))
+ nil)
+
+(cl-defmethod pcache-validate-entry ((entry pcache-entry))
+ (or (null (oref entry value-cls))
+ (object-of-class-p
+ (oref entry value) (oref entry value-cls))))
+
+(cl-defmethod pcache-entry-valid-p ((entry pcache-entry))
+ (let ((ttl (oref entry ttl)))
+ (or (null ttl)
+ (let ((time (float-time (current-time))))
+ (< time (+ ttl (oref entry timestamp)))))))
+
+(cl-defmethod pcache-get ((cache pcache-repository) key &optional default)
+ (let* ((table (oref cache entries))
+ (entry (gethash key table)))
+ (if entry
+ (if (pcache-entry-valid-p entry)
+ (oref entry value)
+ (remhash key table)
+ default)
+ default)))
+
+(cl-defmethod pcache-has ((cache pcache-repository) key)
+ (let* ((default (make-symbol ":nil"))
+ (table (oref cache entries))
+ (entry (gethash key table default)))
+ (if (eq entry default) nil
+ (if (pcache-entry-valid-p entry)
+ t nil))))
+
+(cl-defmethod pcache-put ((cache pcache-repository) key value &optional ttl)
+ (let ((table (oref cache entries))
+ (entry (or (and (eieio-object-p value)
+ (object-of-class-p value 'pcache-entry)
+ value)
+ (make-instance
+ (oref cache entry-cls)
+ :value value
+ :value-cls (and (eieio-object-p value) (eieio-object-class value))))))
+ (when ttl
+ (oset entry :ttl ttl))
+ (prog1
+ (puthash key entry table)
+ (pcache-save cache))))
+
+(cl-defmethod pcache-invalidate ((cache pcache-repository) key)
+ (let ((table (oref cache entries)))
+ (remhash key table)
+ (pcache-save cache)))
+
+(cl-defmethod pcache-clear ((cache pcache-repository))
+ (let* ((entries (oref cache entries))
+ (test (hash-table-test entries))
+ (resize (hash-table-rehash-size entries))
+ (threshold (hash-table-rehash-threshold entries))
+ (weakness (hash-table-weakness entries)))
+ (oset cache :entries (make-hash-table :test test :rehash-size resize
+ :rehash-threshold threshold
+ :weakness weakness)))
+ (pcache-save cache))
+
+(cl-defmethod pcache-purge-invalid ((cache pcache-repository))
+ (let ((table (oref cache entries)))
+ (maphash (lambda (k e)
+ (unless (pcache-entry-valid-p e)
+ (remhash k table)))
+ table)
+ (pcache-save cache)))
+
+(cl-defmethod pcache-save ((cache pcache-repository) &optional force)
+ (let ((timestamp (oref cache timestamp))
+ (delay (oref cache save-delay))
+ (time (float-time (current-time))))
+ (when (or force (> time (+ timestamp delay)))
+ (oset cache :timestamp time)
+ ;; make sure version is saved to file
+ (oset cache :version (oref-default (eieio-object-class cache) version-constant))
+ (eieio-persistent-save cache))))
+
+(cl-defmethod pcache-map ((cache pcache-repository) func)
+ (let ((table (oref cache entries)))
+ (maphash func table)))
+
+(defun pcache-kill-emacs-hook ()
+ (maphash (lambda (k v)
+ (condition-case nil
+ (pcache-purge-invalid v)
+ (error nil))
+ (condition-case nil
+ (pcache-save v t)
+ (error nil)))
+ *pcache-repositories*))
+
+(defun pcache-destroy-repository (name)
+ (remhash name *pcache-repositories*)
+ (let ((fname (concat pcache-directory name)))
+ (when (file-exists-p fname)
+ (delete-file fname))))
+
+(add-hook 'kill-emacs-hook #'pcache-kill-emacs-hook)
+
+;; in case we reload in place, clean all repositories with invalid version
+(let (to-clean)
+ (maphash (lambda (k v)
+ (condition-case nil
+ (unless (eql (oref v version)
+ pcache-version-constant)
+ (signal 'error nil))
+ (error
+ (setq to-clean (cons k to-clean)))))
+ *pcache-repositories*)
+ (dolist (k to-clean)
+ (remhash k *pcache-repositories*)))
+
+(provide 'pcache)
+;;; pcache.el ends here
projects / emacsconfig.git / commitdiff