Permalink
Browse files

initial checkin

  • Loading branch information...
0 parents commit 95aef7c8cb733657d18e3b88d4e2dd738e369e3a @nicferrier committed Sep 30, 2012
Showing with 359 additions and 0 deletions.
  1. +256 −0 db.el
  2. +103 −0 tests.el
@@ -0,0 +1,256 @@
+;;; db.el --- A database for EmacsLisp -*- lexical-binding: t -*-
+
+;; Copyright (C) 2012 Nic Ferrier
+
+;; Author: Nic Ferrier <nferrier@ferrier.me.uk>
+;; Maintainer: Nic Ferrier <nferrier@ferrier.me.uk>
+;; Keywords: data, lisp
+;; Created: 23rd September 2012
+;; Package-Requires: ((kv "0.0.7"))
+;; Version: 0.0.1
+
+;; This program 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 3 of the License, or
+;; (at your option) any later version.
+
+;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This is a simple database interface and implementation.
+;;
+;; It should be possible to specify any kind of key/value database
+;; with this interface.
+;;
+;; The supplied implementation is an Emacs hash-table implementation
+;; backed with serializing objects. It is NOT intended for anything
+;; other than very simple use cases and will not scale very well at
+;; all.
+
+;; However, other implementations (mongodb, redis or PostgreSQL
+;; hstore) would be easy to implement and fit in here.
+
+
+;;; Code:
+
+(eval-when-compile
+ (require 'cl))
+(require 'kv)
+
+(defvar db--types (make-hash-table :test 'eq)
+ "Hash of database type ids against funcs?")
+
+(defun* db-make (reference)
+ "Make a DB based on the REFERENCE."
+ (if (and (listp reference)
+ (eq
+ 'db-hash
+ (car reference)))
+ ;; this should be part of what we find when we look it up?
+ (db-hash reference)
+ ;; Otherwise look it up...
+ (let ((db-func (gethash (car reference) db--types)))
+ (if (functionp db-func)
+ (funcall db-func reference)
+ ;; there should be a specific db error
+ (error "no such database implementation")))))
+
+(defun db-get (key db)
+ "Get the value from the DB with the KEY."
+ (funcall (plist-get db :get) key db))
+
+(defun db-put (key value db)
+ "Put a new VALUE into the DB with the specified KEY.
+
+Return the VALUE as it has been put into the DB."
+ (funcall (plist-get db :put) key value db))
+
+(defun db-map (func db &optional query filter)
+ "Call FUNC for every record in DB optionally QUERY filter.
+
+QUERY, if specified, should be a list of query terms.
+
+FUNC should take 2 arguments:
+
+ KEY DB-VALUE
+
+where the DB-VALUE is whatever the DB has attached to the
+specified KEY.
+
+This returns an alist of the KEY and the value the function
+returned. If FILTER is `t' then only pairs with a value are
+returned."
+ (let (retlist)
+ (funcall (plist-get db :map)
+ (lambda (key value)
+ (when key
+ (setq
+ retlist
+ (cons
+ (funcall func key value)
+ retlist))))
+ db query)
+ (if filter
+ (loop for p in retlist
+ if (cdr p)
+ collect p)
+ retlist)))
+
+(defun db-query (db query)
+ "Do QUERY on DB and return the result.
+
+This is `db-map' with an identity function."
+ (db-map 'kvidentity db query))
+
+(defun db-hash (reference)
+ "Make a db-hash database.
+
+REFERENCE comes from the call to `db-make' and should
+include a `:filename' key arg to point to a file:
+
+ '(db-hash :filename \"/var/local/db/auth-db\")
+
+If the filename exists then it is loaded into the database."
+ (let* ((filename (plist-get (cdr reference) :filename))
+ (db (list
+ :db (make-hash-table :test 'equal)
+ :get 'db-hash-get
+ :put 'db-hash-put
+ :map 'db-hash-map
+ :query-equal 'kvassoq=
+ :filename filename)))
+ (when (and filename
+ (file-exists-p (concat filename ".elc")))
+ (db-hash--read db))
+ ;; Return the database
+ db))
+
+(defun db-hash--read (db)
+ "Loads the DB."
+ (let ((filename (plist-get db :filename)))
+ (when filename
+ (load-file (concat filename ".elc"))
+ (plist-put db :db (symbol-value (intern filename))))))
+
+(defvar db-hash-do-not-save nil
+ "If `t' then do not save the database.
+
+This is very useful for testing.")
+
+(defun db-hash--save (db)
+ "Saves the DB."
+ (unless db-hash-do-not-save
+ (let ((filename (plist-get db :filename)))
+ (when filename
+ ;; Make the parent directory for the db if it doesn't exist
+ (let ((dir (file-name-directory filename)))
+ (unless (file-exists-p dir)
+ (make-directory dir t)))
+ ;; Now store the data
+ (with-temp-file (concat filename ".el")
+ (erase-buffer)
+ (let ((fmt-obj (format
+ "(setq %s (eval-when-compile %S))"
+ (intern filename)
+ (plist-get db :db))))
+ (insert fmt-obj)))
+ ;; And compile it and delete the original
+ (byte-compile-file (concat filename ".el"))
+ (delete-file (concat filename ".el"))))))
+
+(defun db-hash-get (key db)
+ (let ((v (gethash key (plist-get db :db))))
+ v))
+
+(defun db-hash-map (func db &optional query)
+ "Run FUNC for every value in DB.
+
+The QUERY is ignored. We never filter."
+ (let* ((equal-fn (plist-get db :query-equal))
+ (filterfn (kvquery->func query :equal-func equal-fn)))
+ (maphash
+ (lambda (key value)
+ (when (funcall filterfn value)
+ (funcall func key value)))
+ (plist-get db :db))))
+
+(defun db-hash-put (key value db)
+ (let ((v (puthash key value (plist-get db :db))))
+ ;; Instead of saving every time we could simply signal an update
+ ;; and have a timer do the actual save.
+ (db-hash--save db)
+ v))
+
+(defvar db--hash-clear-history nil
+ "History variable for completing read.")
+
+(defun db-hash-clear (db)
+ "Clear the specified DB (a hash-db)."
+ (interactive
+ (list (symbol-value
+ (intern
+ (completing-read
+ "Database: "
+ obarray
+ nil
+ 't
+ nil
+ 'db--hash-clear-history)))))
+ (clrhash (plist-get db :db))
+ (if (file-exists-p (plist-get db :filename))
+ (delete-file (plist-get db :filename))))
+
+
+;; Filter db - let's you filter another db
+
+(defun db-filter-get (key db)
+ (let* ((filter-func (plist-get db :filter))
+ (origin (plist-get db :source))
+ (value (db-get key origin)))
+ (funcall filter-func key value)))
+
+(defun db-filter-put (key value db)
+ (let* ((filter-func (plist-get db :filter))
+ (origin (plist-get db :source))
+ (ret (db-put key value origin)))
+ (funcall filter-func key ret)))
+
+(defun db-filter-map (key db &optional query)
+ (let* ((filter-func (plist-get db :filter))
+ (origin (plist-get db :source)))
+ (mapcar
+ filter-func
+ (db-map key origin query))))
+
+(defun db-filter (reference)
+ "Make a database object that is a filter around another.
+
+The reference should look something like:
+
+ '(db-filter
+ :source (db-hash :filename ....)
+ :filter (lambda (value) ...)
+
+The `:filter' function takes 2 arguments: KEY and VALUE with
+VALUE being the returned value from the `:source' database."
+ (let* ((ref-plist (cdr reference))
+ (db (list
+ :get 'db-filter-get
+ :put 'db-filter-put
+ :map 'db-filter-map
+ :filter (plist-get ref-plist :filter)
+ :source (plist-get ref-plist :source))))
+ db))
+
+(puthash 'db-filter 'db-filter db--types)
+
+(provide 'db)
+
+;;; db.el ends here
@@ -0,0 +1,103 @@
+;;; tests for the emacs db.
+
+(require 'cl)
+(require 'ert)
+(require 'db)
+(require 'kv)
+
+(ert-deftest db-get ()
+ "Test the database interface and the hash implementation."
+ ;; Make a hash-db with no filename
+ (let ((db (db-make '(db-hash))))
+ (should-not (db-get "test-key" db))
+ (db-put "test-key" 321 db)
+ (should
+ (equal
+ 321
+ (db-get "test-key" db)))))
+
+(ert-deftest db-put ()
+ "Test the put interface."
+ (let ((db (db-make '(db-hash))))
+ (should-not (db-get "test-key" db))
+ (should
+ (equal
+ '("1" "2" "3")
+ (db-put "test-key" '("1" "2" "3") db)))))
+
+(ert-deftest db-query ()
+ "Test the query interfce."
+ (let ((db (db-make '(db-hash))))
+ (db-put "test001"
+ '(("username" . "test001")
+ ("title" . "Miss")
+ ("surname" . "Test")) db)
+ (db-put "test002"
+ '(("username" . "test002")
+ ("title" . "Mr")
+ ("surname" . "Test")) db)
+ (should
+ (equal
+ '(("test001"
+ ("username" . "test001")
+ ("title" . "Miss")
+ ("surname" . "Test")))
+ (db-map 'kvidentity db '(= "username" "test001"))))))
+
+
+(ert-deftest db-hash--save ()
+ "Test the saving of a hash db."
+ (unwind-protect
+ (progn
+ (let ((db (db-make
+ ;; You shouldn't use an extension but let elnode deal
+ ;; with it.
+ '(db-hash :filename "/tmp/test-db"))))
+ ;; Override the save so it does nothing from put
+ (flet ((db-hash--save (db)
+ t))
+ (db-put 'test1 "value1" db)
+ (db-put 'test2 "value2" db))
+ ;; And now save
+ (db-hash--save db))
+ ;; And now load in a different scope
+ (let ((db (db-make
+ '(db-hash :filename "/tmp/test-db"))))
+ (should
+ (equal "value1"
+ (db-get 'test1 db)))))
+ (delete-file "/tmp/test-db.elc")))
+
+(ert-deftest db-filter ()
+ "Test the filtering."
+ (let ((db (db-make
+ '(db-hash :filename "/tmp/test-db"))))
+ (db-put
+ "test001"
+ '(("uid" . "test001")
+ ("fullname" . "test user 1"))
+ db)
+ (db-put
+ "test002"
+ '(("uid" . "test002")
+ ("fullname" . "test user 2"))
+ db)
+ (db-put
+ "test003"
+ '(("uid" . "test001")
+ ("fullname" . "test user 1"))
+ db)
+ (flet ((filt (key value)
+ (cdr (assoc "fullname" value))))
+ (let ((filtered
+ (db-make
+ `(db-filter
+ :source ,db
+ :filter filt))))
+ (plist-get filtered :source)
+ (should
+ (equal (db-get "test002" filtered) "test user 2"))))))
+
+(provide 'db-tests)
+
+;;; db-tests.el ends here

0 comments on commit 95aef7c

Please sign in to comment.