├── README.creole ├── db-tests.el └── db.el /README.creole: -------------------------------------------------------------------------------- 1 | = Emacs Db - Key/Values stores for Emacs = 2 | 3 | An EmacsLisp interface to key/value stores (Mongo, Postgresql Hstore, 4 | etc..) with a simple default implementation based on EmacsLisp Hashtables. 5 | 6 | == The interface == 7 | 8 | The idea behind this is to make an interface for interacting with 9 | simple key/value database stores that is portable across all such 10 | stores. So you can make code once but swap out the database with 11 | relative ease. 12 | 13 | The interface includes the following functions: 14 | 15 | === db-make reference === 16 | 17 | Make a DB based on the //reference//. 18 | 19 | === db-get key db === 20 | 21 | Get the value from the //db// with the //key//. 22 | 23 | === db-put key value db === 24 | 25 | Put a new //value// into the //db// with the specified //key//. 26 | 27 | Return the //value// as it has been put into the //db//. 28 | 29 | === db-map func db &optional query filter === 30 | 31 | Call //func// for every record in //db// optionally //query// filter. 32 | 33 | //query//, if specified, should be a list of query terms. 34 | 35 | //func// should take 2 arguments: 36 | 37 | {{{ 38 | key db-value 39 | }}} 40 | 41 | where the DB-VALUE is whatever the //db// has attached to the 42 | specified KEY. 43 | 44 | This returns an alist of the KEY and the value the function 45 | returned. If //filter// is [[t]] then only pairs with a value are 46 | returned. 47 | 48 | === db-query db query === 49 | 50 | Do //query// on //db// and return the result. 51 | 52 | This is [[db-map]] with an identity function. 53 | 54 | 55 | == Query language == 56 | 57 | {{{db}}} uses the query language provided by the {{{kv}}} library, 58 | which is implemented as a mapping function test on ever value by the 59 | persistent hashtable implementation. 60 | 61 | The language should be translatable to just about any database query 62 | language (Mongo, SQL, etc...). 63 | 64 | There are only 3 constructs currently, {{{|}}}, {{{&}}} and {{{=}}}. 65 | 66 | An expression could be: 67 | 68 | {{{ 69 | (= field-name value) 70 | }}} 71 | 72 | To select any record where {{{field-name}}} has the {{{value}}} 73 | 74 | {{{ 75 | (|(= field-name value)(= other-field other-value)) 76 | }}} 77 | 78 | To select any record where {{{field-name}}} has the {{{value}}} 79 | or {{{other-field}}} has the value {{{other-value}}} 80 | 81 | {{{ 82 | (&(= field-name value)(= other-field other-value)) 83 | }}} 84 | 85 | To select any record where {{{field-name}}} has the {{{value}}} 86 | and {{{other-field}}} has the value {{{other-value}}}. 87 | 88 | Logical combinations of {{{|}}} and {{{&}}} are also possible. 89 | 90 | 91 | == Hashtable implementation == 92 | 93 | {{{db}}} comes with a simple implementation which can store any 94 | EmacsLisp object (though alists would most usually be preferred). 95 | 96 | To make a {{{db}}} with the hash implementation: 97 | 98 | {{{ 99 | (db-make 100 | `(db-hash 101 | :filename ,(format "/var/cache/some-file"))) 102 | }}} 103 | 104 | Obviously, most often you will assign the db to a global variable. 105 | 106 | {{{ 107 | (defvar my-db 108 | (db-make 109 | `(db-hash 110 | :filename ,(format "/var/cache/some-file")))) 111 | 112 | (db-put "001" '(("a" . 10)("b" . 20)) my-db) 113 | (db-put "002" '(("a" . 17)("b" . "hello")("xyz" . "well!")) my-db) 114 | (db-get "002" my-db) 115 | }}} 116 | 117 | results in: 118 | 119 | {{{ 120 | (("a" . 17)("b" . "hello")("xyz" . "well!")) 121 | }}} 122 | 123 | === Testing === 124 | 125 | Hash Db's are tied to filenames so to test them you often have to 126 | manage that persistence: 127 | 128 | {{{ 129 | (unwind-protect 130 | (let ((mydb (db-make `(db-hash :filename "/tmp/mydb"))) 131 | (json 132 | (with-temp-buffer 133 | (insert-file-contents "~/work/elmarmalade/users-mongo.json") 134 | (goto-char (point-min)) 135 | (json-read)))) 136 | (--each json (db-put (car it) (cdr it) mydb)) 137 | (list (db-get 'triss mydb) 138 | (db-get 'nicferrier mydb))) 139 | (delete-file "/tmp/mydb.elc")) 140 | }}} 141 | 142 | Note the deleting of the {{{elc}}} file. That's how the hash db is 143 | stored. 144 | 145 | Alternately one could use {{{fakir-file}}} (see the fakir package) to 146 | mock the file system. But that's harder than just creating and 147 | throwing away the file. 148 | -------------------------------------------------------------------------------- /db-tests.el: -------------------------------------------------------------------------------- 1 | ;;; tests for the emacs db. 2 | 3 | (require 'cl) 4 | (require 'ert) 5 | (require 'db) 6 | (require 'kv) 7 | 8 | (ert-deftest db-get () 9 | "Test the database interface and the hash implementation." 10 | ;; Make a hash-db with no filename 11 | (let ((db (db-make '(db-hash)))) 12 | (should-not (db-get "test-key" db)) 13 | (db-put "test-key" 321 db) 14 | (should 15 | (equal 16 | 321 17 | (db-get "test-key" db))))) 18 | 19 | (ert-deftest db-put () 20 | "Test the put interface." 21 | (let ((db (db-make '(db-hash)))) 22 | (should-not (db-get "test-key" db)) 23 | (should 24 | (equal 25 | '("1" "2" "3") 26 | (db-put "test-key" '("1" "2" "3") db))))) 27 | 28 | (ert-deftest db-query () 29 | "Test the query interfce." 30 | (let ((db (db-make '(db-hash)))) 31 | (db-put "test001" 32 | '(("username" . "test001") 33 | ("title" . "Miss") 34 | ("surname" . "Test")) db) 35 | (db-put "test002" 36 | '(("username" . "test002") 37 | ("title" . "Mr") 38 | ("surname" . "Test")) db) 39 | (should 40 | (equal 41 | '(("test001" 42 | ("username" . "test001") 43 | ("title" . "Miss") 44 | ("surname" . "Test"))) 45 | (db-query db '(= "username" "test001")))))) 46 | 47 | (ert-deftest db-map () 48 | "Test the mapping." 49 | (let (collected 50 | (db (db-make '(db-hash :query-equal kvdotassoc=))) 51 | (data '(("test001" 52 | ("username" . "test001") 53 | ("title" . "Miss") 54 | ("surname" . "Test")) 55 | ("test002" 56 | ("username" . "test002") 57 | ("title" . "Mr") 58 | ("surname" . "Test"))))) 59 | (loop for (key . value) in data 60 | do (db-put key value db)) 61 | (db-map (lambda (key value) 62 | (setq 63 | collected 64 | (acons key value collected))) db) 65 | (should 66 | (equal 67 | (kvalist-sort collected 'kvcmp) 68 | (kvalist-sort data 'kvcmp))))) 69 | 70 | (ert-deftest db-query-deep () 71 | "Test the query interface with a dotted query." 72 | (let ((db (db-make '(db-hash :query-equal kvdotassoc=)))) 73 | (db-put "test001" 74 | '(("username" . "test001") 75 | ("details" . (("title" . "Miss") 76 | ("surname" . "Test")))) db) 77 | (db-put "test002" 78 | '(("username" . "test002") 79 | ("details" .(("title" . "Mr") 80 | ("surname" . "Tester")))) db) 81 | (should 82 | (equal 83 | '(("test001" 84 | ("username" . "test001") 85 | ("details" . (("title" . "Miss") 86 | ("surname" . "Test"))))) 87 | (db-query db '(= "details.surname" "Test")))))) 88 | 89 | 90 | (ert-deftest db-hash/save () 91 | "Test the saving of a hash db." 92 | (unwind-protect 93 | (progn 94 | (let ((db (db-make 95 | ;; You shouldn't use an extension but let db deal 96 | ;; with it. 97 | '(db-hash :filename "/tmp/test-db")))) 98 | ;; Override the save so it does nothing from put 99 | (flet ((db-hash/save (db) 100 | t)) 101 | (db-put 'test1 "value1" db) 102 | (db-put 'test2 "value2" db)) 103 | ;; And now save 104 | (db-hash/save db)) 105 | ;; And now load in a different scope 106 | (let ((db (db-make 107 | '(db-hash :filename "/tmp/test-db")))) 108 | (should 109 | (equal "value1" 110 | (db-get 'test1 db))))) 111 | (delete-file "/tmp/test-db.elc"))) 112 | 113 | (ert-deftest db-filter () 114 | "Test the filtering." 115 | (let ((db (db-make 116 | '(db-hash :filename "/tmp/test-db")))) 117 | (db-put 118 | "test001" 119 | '(("uid" . "test001") 120 | ("fullname" . "test user 1")) 121 | db) 122 | (db-put 123 | "test002" 124 | '(("uid" . "test002") 125 | ("fullname" . "test user 2")) 126 | db) 127 | (db-put 128 | "test003" 129 | '(("uid" . "test001") 130 | ("fullname" . "test user 1")) 131 | db) 132 | (flet ((filt (key value) 133 | (cdr (assoc "fullname" value)))) 134 | (let ((filtered 135 | (db-make 136 | `(db-filter 137 | :source ,db 138 | :filter filt)))) 139 | (plist-get filtered :source) 140 | (should 141 | (equal (db-get "test002" filtered) "test user 2")))))) 142 | 143 | (provide 'db-tests) 144 | 145 | ;;; db-tests.el ends here 146 | -------------------------------------------------------------------------------- /db.el: -------------------------------------------------------------------------------- 1 | ;;; db.el --- A database for EmacsLisp -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2012 Nic Ferrier 4 | 5 | ;; Author: Nic Ferrier 6 | ;; Maintainer: Nic Ferrier 7 | ;; Keywords: data, lisp 8 | ;; Created: 23rd September 2012 9 | ;; Package-Requires: ((kv "0.0.11")) 10 | ;; Version: 0.0.6 11 | 12 | ;; This program is free software; you can redistribute it and/or modify 13 | ;; it under the terms of the GNU General Public License as published by 14 | ;; the Free Software Foundation, either version 3 of the License, or 15 | ;; (at your option) any later version. 16 | 17 | ;; This program is distributed in the hope that it will be useful, 18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20 | ;; GNU General Public License for more details. 21 | 22 | ;; You should have received a copy of the GNU General Public License 23 | ;; along with this program. If not, see . 24 | 25 | ;;; Commentary: 26 | 27 | ;; This is a simple database interface and implementation. 28 | ;; 29 | ;; It should be possible to specify any kind of key/value database 30 | ;; with this interface. 31 | ;; 32 | ;; The supplied implementation is an Emacs hash-table implementation 33 | ;; backed with serializing objects. It is NOT intended for anything 34 | ;; other than very simple use cases and will not scale very well at 35 | ;; all. 36 | 37 | ;; However, other implementations (mongodb, redis or PostgreSQL 38 | ;; hstore) would be easy to implement and fit in here. 39 | 40 | 41 | ;;; Code: 42 | 43 | (eval-when-compile 44 | (require 'cl)) 45 | (require 'kv) 46 | 47 | (defun db/make-type-store () 48 | "Make the type store." 49 | (make-hash-table :test 'eq)) 50 | 51 | (defvar db/types (db/make-type-store) 52 | "Hash of database type ids against funcs?") 53 | 54 | (defun* db-make (reference) 55 | "Make a DB based on the REFERENCE." 56 | (if (and (listp reference) 57 | (eq 'db-hash (car reference))) 58 | ;; this should be part of what we find when we look it up? 59 | (db-hash reference) 60 | ;; Otherwise look it up... 61 | (let ((db-func (gethash (car reference) db/types))) 62 | (if (functionp db-func) 63 | (funcall db-func reference) 64 | ;; there should be a specific db error 65 | (error "no such database implementation"))))) 66 | 67 | (defun db-get (key db) 68 | "Get the value from the DB with the KEY." 69 | (funcall (plist-get db :get) key db)) 70 | 71 | (defun db-put (key value db) 72 | "Put a new VALUE into the DB with the specified KEY. 73 | 74 | Return the VALUE as it has been put into the DB." 75 | (funcall (plist-get db :put) key value db)) 76 | 77 | (defun db-map (func db &optional query filter) 78 | "Call FUNC for every record in DB optionally QUERY filter. 79 | 80 | QUERY, if specified, should be a list of query terms as specified 81 | by `kvquery->func'. 82 | 83 | FUNC should take 2 arguments: 84 | 85 | KEY DB-VALUE 86 | 87 | where the DB-VALUE is whatever the DB has attached to the 88 | specified KEY. 89 | 90 | This returns an alist of the KEY and the value the function 91 | returned. If FILTER is `t' then only pairs with a value are 92 | returned." 93 | (let (retlist) 94 | (funcall (plist-get db :map) 95 | (lambda (key value) 96 | (when key 97 | (setq 98 | retlist 99 | (cons 100 | (funcall func key value) 101 | retlist)))) 102 | db query) 103 | (if filter 104 | (loop for p in retlist 105 | if (cdr p) 106 | collect p) 107 | retlist))) 108 | 109 | (defun db-query (db query) 110 | "Do QUERY on DB and return the result. 111 | 112 | The query is as specified by `kvquery->func'. 113 | 114 | This is `db-map' with an identity function." 115 | (db-map 'kvidentity db query)) 116 | 117 | 118 | ;;; Generic utility functions 119 | 120 | (defun db-copy (src-db dest-db) 121 | "Copy the data from SRC-DB into DEST-DB." 122 | (db-map (lambda (key value) 123 | ;;(unless (db-get key dest-db) 124 | (progn 125 | (db-put key value dest-db))) src-db)) 126 | 127 | 128 | ;;; Hash implementation 129 | 130 | (defun db-hash (reference) 131 | "Make a db-hash database. 132 | 133 | REFERENCE comes from the call to `db-make' and should 134 | include a `:filename' key arg to point to a file: 135 | 136 | '(db-hash :filename \"/var/local/db/auth-db\") 137 | 138 | If the filename exists then it is loaded into the database. 139 | 140 | :from-filename let's you specify the source location the db will 141 | be read from. The first version of the hash db tied databases to 142 | specific filenames so you could not easily load a db from one 143 | file location into another. This has been fixed but if you need 144 | to work with a previous version's database you can use 145 | the :from-filename to specify where the db file was located." 146 | (let* ((db-plist (cdr reference)) 147 | (filename (plist-get db-plist :filename)) 148 | (from-filename (plist-get db-plist :from-filename)) 149 | (db (list 150 | :db (make-hash-table :test 'equal) 151 | :get 'db-hash-get 152 | :put 'db-hash-put 153 | :map 'db-hash-map 154 | :query-equal (or 155 | (plist-get db-plist :query-equal) 156 | 'kvassoq=) 157 | :filename filename 158 | :from-filename from-filename))) 159 | (when (and filename 160 | (file-exists-p (concat filename ".elc"))) 161 | (db-hash/read db)) 162 | ;; Return the database 163 | db)) 164 | 165 | (defun db-hash/read (db) 166 | "Loads the DB." 167 | (let* ((filename (plist-get db :filename)) 168 | (source-filename ; this is needed for the crappy old way of 169 | ; saving with a unique filename based symbol 170 | (or 171 | (plist-get db :from-filename) 172 | filename))) 173 | (when filename 174 | (plist-put 175 | db :db 176 | (catch 'return 177 | (progn 178 | ;; The new saving mechanism causes that throw 179 | (load-file (concat filename ".elc")) 180 | ;; the old way used unique symbols 181 | (symbol-value (intern source-filename)))))))) 182 | 183 | (defvar db-hash-do-not-save nil 184 | "If `t' then do not save the database. 185 | 186 | This is very useful for testing.") 187 | 188 | (defun db-hash/save (db) 189 | "Saves the DB." 190 | (unless db-hash-do-not-save 191 | (let ((filename (plist-get db :filename))) 192 | (when filename 193 | ;; Make the parent directory for the db if it doesn't exist 194 | (let ((dir (file-name-directory filename))) 195 | (unless (file-exists-p dir) 196 | (make-directory dir t))) 197 | ;; Now store the data 198 | (with-temp-file (concat filename ".el") 199 | (erase-buffer) 200 | (let ((fmt-obj (format 201 | "(throw 'return %S)" 202 | (plist-get db :db)))) 203 | (insert fmt-obj))) 204 | ;; And compile it and delete the original 205 | (byte-compile-file (concat filename ".el")) 206 | (delete-file (concat filename ".el")))))) 207 | 208 | 209 | (defun db-hash-get (key db) 210 | (let ((v (gethash key (plist-get db :db)))) 211 | v)) 212 | 213 | (defun db-hash-map (func db &optional query) 214 | "Run FUNC for every value in DB. 215 | 216 | The QUERY is ignored. We never filter." 217 | (let* ((equal-fn (plist-get db :query-equal)) 218 | (filterfn (if query 219 | (kvquery->func query :equal-func equal-fn) 220 | 'identity))) 221 | (maphash 222 | (lambda (key value) 223 | (when (funcall filterfn value) 224 | (funcall func key value))) 225 | (plist-get db :db)))) 226 | 227 | (defun db-hash-put (key value db) 228 | (let ((v (puthash key value (plist-get db :db)))) 229 | ;; Instead of saving every time we could simply signal an update 230 | ;; and have a timer do the actual save. 231 | (db-hash/save db) 232 | v)) 233 | 234 | (defvar db/hash-clear-history nil 235 | "History variable for completing read.") 236 | 237 | (defun db-hash-clear (db) 238 | "Clear the specified DB (a hash-db)." 239 | (interactive 240 | (list (symbol-value 241 | (intern 242 | (completing-read 243 | "Database: " 244 | obarray 245 | nil 246 | 't 247 | nil 248 | 'db/hash-clear-history))))) 249 | (clrhash (plist-get db :db)) 250 | (if (file-exists-p (plist-get db :filename)) 251 | (delete-file (plist-get db :filename)))) 252 | 253 | 254 | ;; Filter db - let's you filter another db 255 | 256 | (defun db-filter-get (key db) 257 | (let* ((filter-func (plist-get db :filter)) 258 | (origin (plist-get db :source)) 259 | (value (db-get key origin))) 260 | (funcall filter-func key value))) 261 | 262 | (defun db-filter-put (key value db) 263 | (let* ((filter-func (plist-get db :filter)) 264 | (origin (plist-get db :source)) 265 | (ret (db-put key value origin))) 266 | (funcall filter-func key ret))) 267 | 268 | (defun db-filter-map (key db &optional query) 269 | (let* ((filter-func (plist-get db :filter)) 270 | (origin (plist-get db :source))) 271 | (mapcar 272 | filter-func 273 | (db-map key origin query)))) 274 | 275 | (defun db-filter (reference) 276 | "Make a database object that is a filter around another. 277 | 278 | The reference should look something like: 279 | 280 | '(db-filter 281 | :source (db-hash :filename ....) 282 | :filter (lambda (value) ...) 283 | 284 | The `:filter' function takes 2 arguments: KEY and VALUE with 285 | VALUE being the returned value from the `:source' database." 286 | (let* ((ref-plist (cdr reference)) 287 | (db (list 288 | :get 'db-filter-get 289 | :put 'db-filter-put 290 | :map 'db-filter-map 291 | :filter (plist-get ref-plist :filter) 292 | :source (plist-get ref-plist :source)))) 293 | db)) 294 | 295 | (puthash 'db-filter 'db-filter db/types) 296 | 297 | (defun db-change-timestamp () 298 | "Place a timestamp in the kill-ring for a db change log." 299 | (interactive) 300 | (kill-new (format-time-string "\"%Y%M%d%H%M%S%N\""(current-time)))) 301 | 302 | (defmacro db-change (change-db timestamp &rest change) 303 | "Do CHANGE and make a record in the CHANGE-DB with TIMESTAMP." 304 | (declare (indent 2)) 305 | (let ((cdbv (make-symbol "cdbv")) 306 | (tsv (make-symbol "tsv"))) 307 | `(let ((,cdbv ,change-db) 308 | (,tsv ,timestamp)) 309 | (unless (db-get ,tsv ,cdbv) 310 | (progn 311 | (progn ,@change) 312 | (db-put ,tsv (list (cons "timestamp" ,tsv)) ,cdbv)))))) 313 | 314 | (provide 'db) 315 | 316 | ;;; db.el ends here 317 | --------------------------------------------------------------------------------