[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/sqlite e4c2283 1/2: Rearrange multisession to allow several back
|
From: |
Lars Ingebrigtsen |
|
Subject: |
scratch/sqlite e4c2283 1/2: Rearrange multisession to allow several backends |
|
Date: |
Mon, 13 Dec 2021 21:03:21 -0500 (EST) |
branch: scratch/sqlite
commit e4c2283162b174c100b55ae07efb3ad425be3719
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>
Rearrange multisession to allow several backends
---
lisp/emacs-lisp/multisession.el | 199 +++++++++++++++++------------
test/lisp/emacs-lisp/multisession-tests.el | 124 +++++++++---------
2 files changed, 175 insertions(+), 148 deletions(-)
diff --git a/lisp/emacs-lisp/multisession.el b/lisp/emacs-lisp/multisession.el
index b3119e7..a75134f 100644
--- a/lisp/emacs-lisp/multisession.el
+++ b/lisp/emacs-lisp/multisession.el
@@ -27,10 +27,17 @@
(require 'eieio)
(require 'sqlite)
-(defcustom multisession-database-file
- (expand-file-name "multisession/sqlite/multisession.sqlite"
- user-emacs-directory)
- "File to store multisession variables."
+(defcustom multisession-storage 'sqlite
+ "Storage method for multisession variables.
+Valid methods are `sqlite' and `files'."
+ :type '(choice (const :tag "SQLite" sqlite)
+ (const :tag "Files" files))
+ :version "29.1"
+ :group 'files)
+
+(defcustom multisession-directory (expand-file-name "multisession/"
+ user-emacs-directory)
+ "Directory to store multisession variables."
:type 'file
:version "29.1"
:group 'files)
@@ -74,14 +81,40 @@ DOC should be a doc string, and ARGS are keywords as
applicable to
:initial-value initial-value
:package package))
+(defun multisession-value (object)
+ "Return the value of the multisession OBJECT."
+ (if (or (null user-init-file)
+ (not (sqlite-available-p)))
+ ;; If we don't have storage, then just return the value from the
+ ;; object.
+ (if (markerp (multisession--cached-value object))
+ (multisession--initial-value object)
+ (multisession--cached-value object))
+ ;; We have storage, so we update from storage.
+ (multisession-backend-value multisession-storage object)))
+
+(defun multisession--set-value (object value)
+ (if (or (null user-init-file)
+ (not (sqlite-available-p)))
+ ;; We have no backend, so just store the value.
+ (setf (multisession--cached-value object) value)
+ ;; We have a backend.
+ (multisession--backend-set-value multisession-storage object value)))
+
+(gv-define-simple-setter multisession-value multisession--set-value)
+
+;; SQLite Backend
+
(defvar multisession--db nil)
(defun multisession--ensure-db ()
(unless multisession--db
- (let ((dir (file-name-directory multisession-database-file)))
+ (let* ((file (expand-file-name "sqlite/multisession.sqlite"
+ multisession-directory))
+ (dir (file-name-directory file)))
(unless (file-exists-p dir)
- (make-directory dir t)))
- (setq multisession--db (sqlite-open multisession-database-file))
+ (make-directory dir t))
+ (setq multisession--db (sqlite-open file)))
(with-sqlite-transaction multisession--db
(unless (sqlite-select
multisession--db
@@ -100,95 +133,92 @@ DOC should be a doc string, and ARGS are keywords as
applicable to
multisession--db
"create unique index multisession_idx on multisession (package,
key)")))))
-(defun multisession-value (object)
- "Return the value of the multisession OBJECT."
- (if (or (null user-init-file)
- (not (sqlite-available-p)))
- ;; If we don't have storage, then just return the value from the
- ;; object.
- (if (markerp (multisession--cached-value object))
- (multisession--initial-value object)
- (multisession--cached-value object))
- ;; We have storage, so we update from storage.
- (multisession--ensure-db)
- (let ((id (list (symbol-name (multisession--package object))
- (symbol-name (multisession--key object)))))
- (cond
- ;; We have no value yet; check the database.
- ((markerp (multisession--cached-value object))
- (let ((stored
- (car
- (sqlite-select
- multisession--db
- "select value, sequence from multisession where package = ?
and key = ?"
- id))))
- (if stored
- (let ((value (car (read-from-string (car stored)))))
- (setf (multisession--cached-value object) value
- (multisession--cached-sequence object) (cadr stored))
- value)
- ;; Nothing; 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)
- (let ((stored
- (car
- (sqlite-select
- multisession--db
- "select value, sequence from multisession where sequence > ?
and package = ? and key = ?"
- (cons (multisession--cached-sequence object) id)))))
- (if stored
- (let ((value (car (read-from-string (car stored)))))
- (setf (multisession--cached-value object) value
- (multisession--cached-sequence object) (cadr stored))
- value)
- ;; Nothing, return the cached value.
- (multisession--cached-value object))))
- ;; Just return the cached value.
- (t
- (multisession--cached-value object))))))
+(cl-defmethod multisession-backend-value ((_type (eql sqlite)) object)
+ (multisession--ensure-db)
+ (let ((id (list (symbol-name (multisession--package object))
+ (symbol-name (multisession--key object)))))
+ (cond
+ ;; We have no value yet; check the database.
+ ((markerp (multisession--cached-value object))
+ (let ((stored
+ (car
+ (sqlite-select
+ multisession--db
+ "select value, sequence from multisession where package = ? and
key = ?"
+ id))))
+ (if stored
+ (let ((value (car (read-from-string (car stored)))))
+ (setf (multisession--cached-value object) value
+ (multisession--cached-sequence object) (cadr stored))
+ value)
+ ;; Nothing; 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)
+ (let ((stored
+ (car
+ (sqlite-select
+ multisession--db
+ "select value, sequence from multisession where sequence > ?
and package = ? and key = ?"
+ (cons (multisession--cached-sequence object) id)))))
+ (if stored
+ (let ((value (car (read-from-string (car stored)))))
+ (setf (multisession--cached-value object) value
+ (multisession--cached-sequence object) (cadr stored))
+ value)
+ ;; Nothing, return the cached value.
+ (multisession--cached-value object))))
+ ;; Just return the cached value.
+ (t
+ (multisession--cached-value object)))))
-(defun multisession--set-value (object value)
+(cl-defmethod multisession--backend-set-value ((_type (eql sqlite))
+ object value)
(catch 'done
(let ((i 0))
(while (< i 10)
(condition-case nil
- (throw 'done (multisession--set-value-1 object value))
+ (throw 'done (multisession--set-value-sqlite object value))
(sqlite-locked-error
(setq i (1+ i))
(sleep-for (+ 0.1 (/ (float (random 10)) 10))))))
(signal 'sqlite-locked-error "Database is locked"))))
-(defun multisession--set-value-1 (object value)
- (if (or (null user-init-file)
- (not (sqlite-available-p)))
- ;; We have no backend, so just store the value.
- (setf (multisession--cached-value object) value)
- ;; We have a backend.
- (multisession--ensure-db)
- (with-sqlite-transaction multisession--db
- (let ((id (list (symbol-name (multisession--package object))
- (symbol-name (multisession--key object))))
- (pvalue (prin1-to-string value)))
- (sqlite-execute
- multisession--db
- "insert into multisession(package, key, sequence, value) values(?, ?,
1, ?) on conflict(package, key) do update set sequence = sequence + 1, value =
?"
- (append id (list pvalue pvalue)))
- (setf (multisession--cached-sequence object)
- (caar (sqlite-select
- multisession--db
- "select sequence from multisession where package = ? and
key = ?"
- id)))
- (setf (multisession--cached-value object) value)))))
+(defun multisession--set-value-sqlite (object value)
+ (multisession--ensure-db)
+ (with-sqlite-transaction multisession--db
+ (let ((id (list (symbol-name (multisession--package object))
+ (symbol-name (multisession--key object))))
+ (pvalue (prin1-to-string value)))
+ (sqlite-execute
+ multisession--db
+ "insert into multisession(package, key, sequence, value) values(?, ?,
1, ?) on conflict(package, key) do update set sequence = sequence + 1, value =
?"
+ (append id (list pvalue pvalue)))
+ (setf (multisession--cached-sequence object)
+ (caar (sqlite-select
+ multisession--db
+ "select sequence from multisession where package = ? and
key = ?"
+ id)))
+ (setf (multisession--cached-value object) value))))
-(gv-define-simple-setter multisession-value multisession--set-value)
+(cl-defmethod multisession--backend-values ((_type (eql sqlite)))
+ (sqlite-select
+ multisession--db
+ "select package, key, value from multisession order by package, key"))
+
+(cl-defmethod multisession--backend-delete ((_type (eql sqlite)) id)
+ (sqlite-execute multisession--db
+ "delete from multisession where package = ? and key = ?"
+ id))
;; (define-multisession-variable foo 'bar)
;; (multisession-value foo)
;; (multisession--set-value foo 'zot)
;; (setf (multisession-value foo) 'gazonk)
+;; Mode for editing.
+
(defvar-keymap multisession-edit-mode-map
"d" #'multisession-delete-value)
@@ -206,9 +236,8 @@ DOC should be a doc string, and ARGS are keywords as
applicable to
(pop-to-buffer (get-buffer-create "*Multisession*"))
(let ((inhibit-read-only t))
(erase-buffer)
- (cl-loop for (package key value) in (sqlite-select
- multisession--db
- "select package, key, value from
multisession order by package, key")
+ (cl-loop for (package key value)
+ in (multisession--backend-values multisession-storage)
do (insert (propertize (format "%s %s %s\n"
package key value)
'multisession--id (list package key))))
@@ -217,11 +246,11 @@ DOC should be a doc string, and ARGS are keywords as
applicable to
(defun multisession-delete-value (id)
"Delete the value at point."
- (interactive (list (get-text-property (point) 'multisession--id))
multisession-edit-mode)
+ (interactive (list (get-text-property (point) 'multisession--id))
+ multisession-edit-mode)
(unless id
(error "No value on the current line"))
- (sqlite-execute multisession--db "delete from multisession where package = ?
and key = ?"
- id)
+ (multisession--backend-delete multisession-storage id)
(let ((inhibit-read-only t))
(beginning-of-line)
(delete-region (point) (progn (forward-line 1) (point)))))
diff --git a/test/lisp/emacs-lisp/multisession-tests.el
b/test/lisp/emacs-lisp/multisession-tests.el
index b26a8e0..c08fa20 100644
--- a/test/lisp/emacs-lisp/multisession-tests.el
+++ b/test/lisp/emacs-lisp/multisession-tests.el
@@ -28,73 +28,71 @@
(ert-deftest multi-test-simple ()
(skip-unless (sqlite-available-p))
- (let ((multisession-database-file (make-temp-name "/tmp/multi"))
- (user-init-file "/tmp/foo.el"))
- (unwind-protect
- (progn
- (define-multisession-variable foo 0
- ""
- :synchronized t)
- (should (= (multisession-value foo) 0))
- (cl-incf (multisession-value foo))
- (should (= (multisession-value foo) 1))
- (call-process
- (concat invocation-directory invocation-name)
- nil t nil
- "-Q" "-batch"
- "--eval" (prin1-to-string
- `(progn
- (require 'multisession)
- (let ((multisession-database-file
- ,multisession-database-file)
- (user-init-file "/tmp/foo.el"))
- (define-multisession-variable foo 0
- ""
- :synchronized t)
- (cl-incf (multisession-value foo))))))
- (should (= (multisession-value foo) 2)))
- (when (file-exists-p multisession-database-file)
- (delete-file multisession-database-file)
+ (ert-with-temp-file dir
+ :directory t
+ (let ((user-init-file "/tmp/foo.el")
+ (multisession-directory dir))
+ (unwind-protect
+ (progn
+ (define-multisession-variable foo 0
+ ""
+ :synchronized t)
+ (should (= (multisession-value foo) 0))
+ (cl-incf (multisession-value foo))
+ (should (= (multisession-value foo) 1))
+ (call-process
+ (concat invocation-directory invocation-name)
+ nil t nil
+ "-Q" "-batch"
+ "--eval" (prin1-to-string
+ `(progn
+ (require 'multisession)
+ (let ((multisession-directory ,dir)
+ (user-init-file "/tmp/foo.el"))
+ (define-multisession-variable foo 0
+ ""
+ :synchronized t)
+ (cl-incf (multisession-value foo))))))
+ (should (= (multisession-value foo) 2)))
(sqlite-close multisession--db)
(setq multisession--db nil)))))
(ert-deftest multi-test-busy ()
- (skip-unless (sqlite-available-p))
- (let ((multisession-database-file (make-temp-name "/tmp/multi"))
- (user-init-file "/tmp/bar.el")
- proc)
- (unwind-protect
- (progn
- (define-multisession-variable bar 0
- ""
- :synchronized t)
- (should (= (multisession-value bar) 0))
- (cl-incf (multisession-value bar))
- (should (= (multisession-value bar) 1))
- (setq proc
- (start-process
- "other-emacs"
- nil
- (concat invocation-directory invocation-name)
- "-Q" "-batch"
- "--eval" (prin1-to-string
- `(progn
- (require 'multisession)
- (let ((multisession-database-file
- ,multisession-database-file)
- (user-init-file "/tmp/bar.el"))
- (define-multisession-variable bar 0
- "" :synchronized t)
- (dotimes (i 1000)
- (cl-incf (multisession-value bar))))))))
- (while (process-live-p proc)
- (ignore-error 'sqlite-locked-error
- (cl-incf (multisession-value bar)))
- (sleep-for 0.1))
- (message "bar ends up as %s" (multisession-value bar))
- (should (< (multisession-value bar) 1003)))
- (when (file-exists-p multisession-database-file)
- (delete-file multisession-database-file)
+ (skip-unless (and t (sqlite-available-p)))
+ (ert-with-temp-file dir
+ :directory t
+ (let ((user-init-file "/tmp/foo.el")
+ (multisession-directory dir)
+ proc)
+ (unwind-protect
+ (progn
+ (define-multisession-variable bar 0
+ ""
+ :synchronized t)
+ (should (= (multisession-value bar) 0))
+ (cl-incf (multisession-value bar))
+ (should (= (multisession-value bar) 1))
+ (setq proc
+ (start-process
+ "other-emacs"
+ nil
+ (concat invocation-directory invocation-name)
+ "-Q" "-batch"
+ "--eval" (prin1-to-string
+ `(progn
+ (require 'multisession)
+ (let ((multisession-database-file ,dir)
+ (user-init-file "/tmp/bar.el"))
+ (define-multisession-variable bar 0
+ "" :synchronized t)
+ (dotimes (i 1000)
+ (cl-incf (multisession-value bar))))))))
+ (while (process-live-p proc)
+ (ignore-error 'sqlite-locked-error
+ (cl-incf (multisession-value bar)))
+ (sleep-for 0.1))
+ (message "bar ends up as %s" (multisession-value bar))
+ (should (< (multisession-value bar) 1003)))
(sqlite-close multisession--db)
(setq multisession--db nil)))))