Skip to content
Newer
Older
100644 257 lines (206 sloc) 7.56 KB
95aef7c @nicferrier initial checkin
authored
1 ;;; db.el --- A database for EmacsLisp -*- lexical-binding: t -*-
2
3 ;; Copyright (C) 2012 Nic Ferrier
4
5 ;; Author: Nic Ferrier <nferrier@ferrier.me.uk>
6 ;; Maintainer: Nic Ferrier <nferrier@ferrier.me.uk>
7 ;; Keywords: data, lisp
8 ;; Created: 23rd September 2012
9 ;; Package-Requires: ((kv "0.0.7"))
10 ;; Version: 0.0.1
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 <http://www.gnu.org/licenses/>.
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 (defvar db--types (make-hash-table :test 'eq)
48 "Hash of database type ids against funcs?")
49
50 (defun* db-make (reference)
51 "Make a DB based on the REFERENCE."
52 (if (and (listp reference)
53 (eq
54 'db-hash
55 (car reference)))
56 ;; this should be part of what we find when we look it up?
57 (db-hash reference)
58 ;; Otherwise look it up...
59 (let ((db-func (gethash (car reference) db--types)))
60 (if (functionp db-func)
61 (funcall db-func reference)
62 ;; there should be a specific db error
63 (error "no such database implementation")))))
64
65 (defun db-get (key db)
66 "Get the value from the DB with the KEY."
67 (funcall (plist-get db :get) key db))
68
69 (defun db-put (key value db)
70 "Put a new VALUE into the DB with the specified KEY.
71
72 Return the VALUE as it has been put into the DB."
73 (funcall (plist-get db :put) key value db))
74
75 (defun db-map (func db &optional query filter)
76 "Call FUNC for every record in DB optionally QUERY filter.
77
78 QUERY, if specified, should be a list of query terms.
79
80 FUNC should take 2 arguments:
81
82 KEY DB-VALUE
83
84 where the DB-VALUE is whatever the DB has attached to the
85 specified KEY.
86
87 This returns an alist of the KEY and the value the function
88 returned. If FILTER is `t' then only pairs with a value are
89 returned."
90 (let (retlist)
91 (funcall (plist-get db :map)
92 (lambda (key value)
93 (when key
94 (setq
95 retlist
96 (cons
97 (funcall func key value)
98 retlist))))
99 db query)
100 (if filter
101 (loop for p in retlist
102 if (cdr p)
103 collect p)
104 retlist)))
105
106 (defun db-query (db query)
107 "Do QUERY on DB and return the result.
108
109 This is `db-map' with an identity function."
110 (db-map 'kvidentity db query))
111
112 (defun db-hash (reference)
113 "Make a db-hash database.
114
115 REFERENCE comes from the call to `db-make' and should
116 include a `:filename' key arg to point to a file:
117
118 '(db-hash :filename \"/var/local/db/auth-db\")
119
120 If the filename exists then it is loaded into the database."
121 (let* ((filename (plist-get (cdr reference) :filename))
122 (db (list
123 :db (make-hash-table :test 'equal)
124 :get 'db-hash-get
125 :put 'db-hash-put
126 :map 'db-hash-map
127 :query-equal 'kvassoq=
128 :filename filename)))
129 (when (and filename
130 (file-exists-p (concat filename ".elc")))
131 (db-hash--read db))
132 ;; Return the database
133 db))
134
135 (defun db-hash--read (db)
136 "Loads the DB."
137 (let ((filename (plist-get db :filename)))
138 (when filename
139 (load-file (concat filename ".elc"))
140 (plist-put db :db (symbol-value (intern filename))))))
141
142 (defvar db-hash-do-not-save nil
143 "If `t' then do not save the database.
144
145 This is very useful for testing.")
146
147 (defun db-hash--save (db)
148 "Saves the DB."
149 (unless db-hash-do-not-save
150 (let ((filename (plist-get db :filename)))
151 (when filename
152 ;; Make the parent directory for the db if it doesn't exist
153 (let ((dir (file-name-directory filename)))
154 (unless (file-exists-p dir)
155 (make-directory dir t)))
156 ;; Now store the data
157 (with-temp-file (concat filename ".el")
158 (erase-buffer)
159 (let ((fmt-obj (format
160 "(setq %s (eval-when-compile %S))"
161 (intern filename)
162 (plist-get db :db))))
163 (insert fmt-obj)))
164 ;; And compile it and delete the original
165 (byte-compile-file (concat filename ".el"))
166 (delete-file (concat filename ".el"))))))
167
168 (defun db-hash-get (key db)
169 (let ((v (gethash key (plist-get db :db))))
170 v))
171
172 (defun db-hash-map (func db &optional query)
173 "Run FUNC for every value in DB.
174
175 The QUERY is ignored. We never filter."
176 (let* ((equal-fn (plist-get db :query-equal))
177 (filterfn (kvquery->func query :equal-func equal-fn)))
178 (maphash
179 (lambda (key value)
180 (when (funcall filterfn value)
181 (funcall func key value)))
182 (plist-get db :db))))
183
184 (defun db-hash-put (key value db)
185 (let ((v (puthash key value (plist-get db :db))))
186 ;; Instead of saving every time we could simply signal an update
187 ;; and have a timer do the actual save.
188 (db-hash--save db)
189 v))
190
191 (defvar db--hash-clear-history nil
192 "History variable for completing read.")
193
194 (defun db-hash-clear (db)
195 "Clear the specified DB (a hash-db)."
196 (interactive
197 (list (symbol-value
198 (intern
199 (completing-read
200 "Database: "
201 obarray
202 nil
203 't
204 nil
205 'db--hash-clear-history)))))
206 (clrhash (plist-get db :db))
207 (if (file-exists-p (plist-get db :filename))
208 (delete-file (plist-get db :filename))))
209
210
211 ;; Filter db - let's you filter another db
212
213 (defun db-filter-get (key db)
214 (let* ((filter-func (plist-get db :filter))
215 (origin (plist-get db :source))
216 (value (db-get key origin)))
217 (funcall filter-func key value)))
218
219 (defun db-filter-put (key value db)
220 (let* ((filter-func (plist-get db :filter))
221 (origin (plist-get db :source))
222 (ret (db-put key value origin)))
223 (funcall filter-func key ret)))
224
225 (defun db-filter-map (key db &optional query)
226 (let* ((filter-func (plist-get db :filter))
227 (origin (plist-get db :source)))
228 (mapcar
229 filter-func
230 (db-map key origin query))))
231
232 (defun db-filter (reference)
233 "Make a database object that is a filter around another.
234
235 The reference should look something like:
236
237 '(db-filter
238 :source (db-hash :filename ....)
239 :filter (lambda (value) ...)
240
241 The `:filter' function takes 2 arguments: KEY and VALUE with
242 VALUE being the returned value from the `:source' database."
243 (let* ((ref-plist (cdr reference))
244 (db (list
245 :get 'db-filter-get
246 :put 'db-filter-put
247 :map 'db-filter-map
248 :filter (plist-get ref-plist :filter)
249 :source (plist-get ref-plist :source))))
250 db))
251
252 (puthash 'db-filter 'db-filter db--types)
253
254 (provide 'db)
255
256 ;;; db.el ends here
Something went wrong with that request. Please try again.