scratch/sqlite 167278e 2/2: Implement a simple file-based multisesson storage

[Lars Ingebrigtsen]

branch: scratch/sqlite
commit 167278eb608541785871471c5cde7c7644c94e84
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Implement a simple file-based multisesson storage
---
 lisp/emacs-lisp/multisession.el            | 86 ++++++++++++++++++++++++++++++
 test/lisp/emacs-lisp/multisession-tests.el | 32 ++++++++++-
 2 files changed, 116 insertions(+), 2 deletions(-)

diff --git a/lisp/emacs-lisp/multisession.el b/lisp/emacs-lisp/multisession.el
index a75134f..a020bb2 100644
--- a/lisp/emacs-lisp/multisession.el
+++ b/lisp/emacs-lisp/multisession.el
@@ -212,6 +212,92 @@ DOC should be a doc string, and ARGS are keywords as 
applicable to
                   "delete from multisession where package = ? and key = ?"
                   id))
 
+;; Files Backend
+
+(defun multisession--encode-file-name (name)
+  (url-hexify-string name))
+
+(defun multisession--update-file-value (file object)
+  (with-temp-buffer
+    (let* ((time (file-attribute-modification-time
+                  (file-attributes file)))
+           (coding-system-for-read 'utf-8))
+      (insert-file-contents file)
+      (let ((stored (read (current-buffer))))
+        (setf (multisession--cached-value object) stored
+              (multisession--cached-sequence object) time)
+        stored))))
+
+(defun multisession--object-file-name (object)
+  (expand-file-name
+   (concat "files/"
+           (multisession--encode-file-name
+            (symbol-name (multisession--package object)))
+           "/"
+           (multisession--encode-file-name
+            (symbol-name (multisession--key object)))
+           ".value")
+   multisession-directory))
+
+(cl-defmethod multisession-backend-value ((_type (eql files)) object)
+  (let ((file (multisession--object-file-name object)))
+    (cond
+     ;; We have no value yet; see whether it's stored.
+     ((markerp (multisession--cached-value object))
+      (if (file-exists-p file)
+          (multisession--update-file-value file object)
+        ;; Nope; return the initial value.
+        (multisession--initial-value object)))
+     ;; We have a value, but we want to update in case some other
+     ;; Emacs instance has updated.
+     ((multisession--synchronized object)
+      (if (and (file-exists-p file)
+               (time-less-p (multisession--cached-sequence object)
+                            (file-attribute-modification-time
+                             (file-attributes file))))
+          (multisession--update-file-value file object)
+        ;; Nothing, return the cached value.
+        (multisession--cached-value object)))
+     ;; Just return the cached value.
+     (t
+      (multisession--cached-value object)))))
+
+(cl-defmethod multisession--backend-set-value ((_type (eql files))
+                                               object value)
+  (let ((file (multisession--object-file-name object))
+        (time (current-time)))
+    ;; Ensure that the directory exists.
+    (let ((dir (file-name-directory file)))
+      (unless (file-exists-p dir)
+        (make-directory dir t)))
+    (with-temp-buffer
+      (prin1 value (current-buffer))
+      (let ((coding-system-for-write 'utf-8))
+        (write-region (point-min) (point-max) file nil 'silent)))
+    (setf (multisession--cached-sequence object) time
+          (multisession--cached-value object) value)))
+
+(cl-defmethod multisession--backend-values ((_type (eql files)))
+  (mapcar (lambda (file)
+            (let ((bits (file-name-split file)))
+              (list (car (last bits 1))
+                    (file-name-sans-extension (car (last bits)))
+                    (with-temp-buffer
+                      (let ((coding-system-for-read 'utf-8))
+                        (insert-file-contents file)
+                        (read (current-buffer)))))))
+          (directory-files-recursively
+           (expand-file-name "files" multisession-directory)
+           "\\.value\\'")))
+
+(cl-defmethod multisession--backend-delete ((_type (eql files)) id)
+  (let ((file (multisession--object-file-name
+               (make-instance 'multisession
+                              :package (car id)
+                              :key (cadr id)))))
+    (when (file-exists-p file)
+      (delete-file file))))
+
 ;; (define-multisession-variable foo 'bar)
 ;; (multisession-value foo)
 ;; (multisession--set-value foo 'zot)
diff --git a/test/lisp/emacs-lisp/multisession-tests.el 
b/test/lisp/emacs-lisp/multisession-tests.el
index c08fa20..94db552 100644
--- a/test/lisp/emacs-lisp/multisession-tests.el
+++ b/test/lisp/emacs-lisp/multisession-tests.el
@@ -26,7 +26,7 @@
 (require 'ert-x)
 (require 'cl-lib)
 
-(ert-deftest multi-test-simple ()
+(ert-deftest multi-test-sqlite-simple ()
   (skip-unless (sqlite-available-p))
   (ert-with-temp-file dir
     :directory t
@@ -57,7 +57,7 @@
         (sqlite-close multisession--db)
         (setq multisession--db nil)))))
 
-(ert-deftest multi-test-busy ()
+(ert-deftest multi-test-sqlite-busy ()
   (skip-unless (and t (sqlite-available-p)))
   (ert-with-temp-file dir
     :directory t
@@ -96,4 +96,32 @@
         (sqlite-close multisession--db)
         (setq multisession--db nil)))))
 
+(ert-deftest multi-test-files-simple ()
+  (ert-with-temp-file dir
+    :directory t
+    (let ((user-init-file "/tmp/sfoo.el")
+          (multisession-storage 'files)
+          (multisession-directory dir))
+      (define-multisession-variable sfoo 0
+        ""
+        :synchronized t)
+      (should (= (multisession-value sfoo) 0))
+      (cl-incf (multisession-value sfoo))
+      (should (= (multisession-value sfoo) 1))
+      (call-process
+       (concat invocation-directory invocation-name)
+       nil t nil
+       "-Q" "-batch"
+       "--eval" (prin1-to-string
+                 `(progn
+                    (require 'multisession)
+                    (let ((multisession-directory ,dir)
+                          (multisession-storage 'files)
+                          (user-init-file "/tmp/sfoo.el"))
+                      (define-multisession-variable sfoo 0
+                        ""
+                        :synchronized t)
+                      (cl-incf (multisession-value sfoo))))))
+      (should (= (multisession-value sfoo) 2)))))
+
 ;;; multisession-tests.el ends here