├── README.creole ├── db-pg-tests.el └── db-pg.el /README.creole: -------------------------------------------------------------------------------- 1 | = KeyValue Database on PostgreSQL = 2 | 3 | A Postgresql interface for 4 | [[http://github.com/nicferrier/emacs-db|emacs-db]], the basic 5 | database interface for EmacsLisp. 6 | 7 | 8 | == Example usage == 9 | 10 | Here's a small example that shows, at least, how to specify the 11 | connection details: 12 | 13 | {{{ 14 | ##! emacs-lisp 15 | (let ((db 16 | (db-make 17 | '(db-pg 18 | :db "my-db" :username "nic" 19 | :table "t1" :column "c1" :key "a")))) 20 | (db-get "10" db)) 21 | 22 | => '(("a" . 10)("b" . "20")) 23 | }}} 24 | 25 | 26 | == A note on Hstores == 27 | 28 | This relies on a feature of PostgreSQL called hstore's. Hstores are 29 | key/value stores in PostgreSQL. 30 | 31 | A single hstore column is used to store the key/values for any 32 | particular database instance in {{{db-pg}}}. 33 | 34 | You can create an Hstore column in PostgreSQL like this: 35 | 36 | {{{ 37 | ##! sql 38 | create table my_table 39 | (my_column hstore); 40 | }}} 41 | 42 | The hstore column is all that's important to {{{db-pg}}}. It doesn't 43 | care what else is in the table, the table could have many more 44 | columns. 45 | 46 | === Table creation === 47 | 48 | //db-pg// will test for existance of the specified table when the 49 | {{{db-make}}} is evaluated. If the table does not exist it is created 50 | by {{{db-pg/create-table}}}. 51 | 52 | In the future the CREATE TABLE will be customizable. 53 | 54 | === Hstores and schemas and maintainability === 55 | 56 | Hstores are about rapid development. You can put data in to the 57 | database in any structure and throw it away and have a new structure 58 | with very little difficulty. 59 | 60 | This is a good thing until you cease rapidly developing, then the 61 | advantages of a more defined schema become more important. But Hstores 62 | don't prevent that. Once you have a more settled application you 63 | should start to define the schema of your data. When using Hstores you 64 | can do this as a trigger based normalization of your hstore value to 65 | your schema. 66 | 67 | The advantage of doing it this way is that the entire database schema 68 | definition is expressed in SQL, it is a function mapping an Hstore (or 69 | many Hstores) to SQL-tables. 70 | 71 | It's the definition of this mapping that I aim to introduce to this 72 | code as CREATE TABLE customizations. 73 | 74 | 75 | == Tests == 76 | 77 | There are tests but most of them require a real postgresql. The 78 | database used is the const {{{db-pg-tests-db}}}. 79 | 80 | 81 | == Emacs all the way down == 82 | 83 | Postgresql is the Emacs of the database world. So combine the two! 84 | -------------------------------------------------------------------------------- /db-pg-tests.el: -------------------------------------------------------------------------------- 1 | ;;; db-pg-tests - tests for postgresql database 2 | 3 | (require 'db) 4 | (require 'db-pg) 5 | (require 'ert) 6 | (require 'cl) 7 | 8 | ;; All of these tests have the problem that they need my database to 9 | ;; create them 10 | 11 | 12 | 13 | (defconst db-pg-tests-db "emacs-db-pg-test" 14 | "The name we use for the tests.") 15 | 16 | ;; The creation of the database should: 17 | ;; 18 | ;; * create the db `db-pg-tests-db' 19 | ;; * turn on the hstore extension in it 20 | ;; psql `db-pg-tests-db' -e 'CREATE EXTENSION hstore'; 21 | 22 | 23 | (ert-deftest db-pg () 24 | "Test the reference creation stuff." 25 | (should 26 | (equal 27 | (list :db db-pg-tests-db :username "nferrier" 28 | :host "localhost" :password "" :port 5432 29 | :table "t1" :column "c1" :key "a") 30 | (plist-get 31 | ;; The reference has to start with db-pg symbol 32 | (db-pg (list 'db-pg 33 | :db db-pg-tests-db :username "nferrier" 34 | :table "t1" :column "c1" :key "a")) 35 | :pg-spec)))) 36 | 37 | (ert-deftest db-pg-make () 38 | (let ((db/types (db/make-type-store))) 39 | (puthash 'db-pg 'db-pg db/types) 40 | (should 41 | (equal 42 | (list :get 'db-pg/get :put 'db-pg/put :map 'db-pg/map 43 | :pg-spec (list :db db-pg-tests-db :username "nferrier" 44 | :host "localhost" :password "" :port 5432 45 | :table "t1" :column "c1" :key "a")) 46 | (db-make `(db-pg 47 | :db ,db-pg-tests-db :username "nferrier" 48 | :table "t1" :column "c1" :key "a")))))) 49 | 50 | (ert-deftest db-pg/ref->spec () 51 | (let ((db/types (db/make-type-store))) 52 | (puthash 'db-pg 'db-pg db/types) 53 | (let ((db (db-make `(db-pg 54 | :db ,db-pg-tests-db :username "nferrier" 55 | :table "t1" :column "c1" :key "a")))) 56 | (should 57 | (equal 58 | (list db-pg-tests-db "nferrier" "" "localhost" 5432) 59 | (db-pg/ref->spec db)))))) 60 | 61 | (defun db-pg/truncate (db &optional con) 62 | "Truncate the table specified in DB. 63 | 64 | If CON is supplied it's presumed to be an open DB connection." 65 | (flet ((truncate (con table) 66 | (pg:exec 67 | con 68 | (format "truncate table %s" table)))) 69 | (let* ((pg-spec (plist-get db :pg-spec)) 70 | (table (plist-get pg-spec :table))) 71 | (if con 72 | (truncate con table) 73 | (with-pg-connection con (db-pg/ref->spec db) 74 | (truncate con table)))))) 75 | 76 | (defun db-pg/test-insert (db alist) 77 | "Testing function inserts ALIST as an HSTORE into DB." 78 | (with-pg-connection con (db-pg/ref->spec db) 79 | (let* ((pg-spec (plist-get db :pg-spec)) 80 | (table (plist-get pg-spec :table)) 81 | (column (plist-get pg-spec :column)) 82 | (vals (mapconcat 83 | (lambda (v) 84 | (format 85 | "%s=>%s" 86 | (car v) (cdr v))) alist ","))) 87 | (db-pg/truncate db con) 88 | (pg:exec 89 | con 90 | (format "insert into %s (%s) values ('%s')" 91 | table column vals))))) 92 | 93 | ;; This requires a working db 94 | (ert-deftest db-pg/get () 95 | (let ((db/types (db/make-type-store))) 96 | (puthash 'db-pg 'db-pg db/types) 97 | (let ((db (db-make 98 | `(db-pg 99 | :db ,db-pg-tests-db :username "nferrier" 100 | :table "t1" :column "c1" :key "a")))) 101 | (db-pg/test-insert db '(("g" . 10)(a . t1))) 102 | (should 103 | (equal 104 | '(("g" . "10")("a" . "t1")) 105 | (db-get "t1" db)))))) 106 | 107 | (ert-deftest db-pg/put () 108 | (let ((db/types (db/make-type-store))) 109 | (puthash 'db-pg 'db-pg db/types) 110 | (let ((db (db-make 111 | `(db-pg 112 | :db ,db-pg-tests-db :username "nferrier" 113 | :table "t1" :column "c1" :key "a")))) 114 | ;; Test an insert 115 | (db-pg/truncate db) 116 | (should 117 | (equal 118 | '(("g" . "12")("a" . "t1")) 119 | (db-put "a" '(("a" . "t1")("g" . 12)) db))) 120 | ;; Test an update 121 | (should 122 | (equal 123 | '(("g" . "10")("a" . "t1")) 124 | (db-put "a" '(("a" . "t1")("g" . 10)) db)))))) 125 | 126 | (ert-deftest db-pg/map () 127 | (let ((db/types (db/make-type-store))) 128 | (puthash 'db-pg 'db-pg db/types) 129 | (let ((db (db-make 130 | `(db-pg 131 | :db ,db-pg-tests-db :username "nferrier" 132 | :table "t1" :column "c1" :key "a")))) 133 | (db-pg/test-insert db '(("g" . 10)(a . t1))) 134 | (should 135 | (equal 136 | '((("g" . "10")("a" . "t1"))) 137 | (db-map (lambda (key val) val) db)))))) 138 | 139 | (ert-deftest db-pg/query () 140 | (let ((db/types (db/make-type-store))) 141 | (puthash 'db-pg 'db-pg db/types) 142 | (let ((db (db-make 143 | `(db-pg 144 | :db ,db-pg-tests-db :username "nferrier" 145 | :table "t1" :column "c1" :key "a")))) 146 | (should 147 | (equal 148 | '(("t1" ("g" . "10")("a" . "t1"))) 149 | (db-query db '((= "g" 10)))))))) 150 | 151 | ;;; db-pg-tests.el ends here 152 | -------------------------------------------------------------------------------- /db-pg.el: -------------------------------------------------------------------------------- 1 | ;;; db-pg.el --- A PostgreSQL adapter for emacs-db 2 | 3 | ;; Copyright (C) 2012 Nic Ferrier 4 | ;; Author: Nic Ferrier 5 | ;; Version: 0.0.3 6 | ;; Keywords: data comm database postgresql 7 | ;; Created: 23 December 2012 8 | ;; Package-Requires: ((pg "0.12")(db "0.0.6")) 9 | 10 | ;; This program is free software; you can redistribute it and/or modify 11 | ;; it under the terms of the GNU General Public License as published by 12 | ;; the Free Software Foundation, either version 3 of the License, or 13 | ;; (at your option) any later version. 14 | 15 | ;; This program is distributed in the hope that it will be useful, 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 | ;; GNU General Public License for more details. 19 | 20 | ;; You should have received a copy of the GNU General Public License 21 | ;; along with this program. If not, see . 22 | 23 | ;;; Commentary: 24 | 25 | ;; This is a PostgreSQL adapter for emacs-db. Emacs-DB can be found in 26 | ;; the Marmalade repository. 27 | 28 | ;; See the README for usage. 29 | 30 | (require 'pg) 31 | (require 'json) 32 | (require 'db) 33 | 34 | (defconst db-pg/table-query 35 | "select c.relname 36 | from pg_catalog.pg_class c 37 | left join pg_catalog.pg_namespace n on n.oid = c.relnamespace 38 | where n.nspname = 'public'" 39 | "The query we use to find the list of tables. 40 | 41 | This isn't ideal because it forces the use of 'public' as the 42 | schema name but that could be fixed if we ever need non-public 43 | schemas (we will).") 44 | 45 | (defun db-pg/list-tables (con) 46 | "Get the list of tables from connection CON." 47 | (let ((res (pg:exec con db-pg/table-query))) 48 | (loop for row in (pg:result res :tuples) 49 | collect (car row)))) 50 | 51 | (defun db-pg/ref->spec (ref) 52 | "Convert the `db' REF to `pg:connect' details." 53 | (let ((pg-spec (plist-get ref :pg-spec))) 54 | (list (plist-get pg-spec :db) 55 | (plist-get pg-spec :username) 56 | ;; FIXME - work out how to get defaults into here 57 | (or (plist-get pg-spec :password) "") 58 | (or (plist-get pg-spec :host) "localhost") 59 | (or (plist-get pg-spec :port) 5432)))) 60 | 61 | (defun db-pg/create-table (con table column) 62 | "Create a suitable TABLE with COLUMN for db-pg use." 63 | (let ((result 64 | (pg:exec 65 | con 66 | (format 67 | "create table %s (%s hstore);" 68 | table 69 | column)))) 70 | (pg:result result :status))) 71 | 72 | (defun db-pg (reference) 73 | "Make a Postgresql database utlizing Hstore types. 74 | 75 | REFERENCE comes from the call to `db-make' and MUST include: 76 | 77 | `:username' key with a username to connect to the postgresql db 78 | `:db' key with a postgresql database name 79 | `:table' key with a table name to use 80 | `:column' key with a column name to use 81 | `:key' key with key name to use 82 | 83 | And can also include: 84 | 85 | `:host' key with a postgresql server hostname 86 | `:port' key with the tcp port of the postgresql server 87 | 88 | This function checks for the existance of `:table' and if it does 89 | not exist it causes the table to be created with the necessary 90 | HSTORE column by the function `db-pg/create-table'." 91 | (destructuring-bind (&key 92 | db 93 | username 94 | (host "localhost") 95 | (password "") 96 | (port 5432) 97 | table 98 | column 99 | key) (cdr reference) 100 | (let* ((db-spec 101 | (list 102 | :get 'db-pg/get 103 | :put 'db-pg/put 104 | :map 'db-pg/map 105 | :pg-spec 106 | (list :db db :username username 107 | :host host :password password :port port 108 | :table table :column column :key key)))) 109 | ;; Check that the table exists 110 | (with-pg-connection 111 | con (db-pg/ref->spec db-spec) 112 | (let* ((tables (db-pg/list-tables con)) 113 | (table-exists (member table tables))) 114 | (unless table-exists 115 | (db-pg/create-table con table column)))) 116 | ;; Return the database 117 | db-spec))) 118 | 119 | 120 | (defun db-pg/alist->hstore (alist) 121 | "Convert ALIST to a potsgresql Hstore representation. 122 | 123 | Hstore representation is like this: key-a=>value,key-b=>value." 124 | (loop for (key . val) in alist 125 | if (> (length result) 0) 126 | concat "," into result 127 | concat (format "%s=>\"%s\"" key val) into result 128 | finally return result)) 129 | 130 | (defun db-pg/select (column table &optional where-key where-val) 131 | (format 132 | "select '{' || 133 | (select array_to_string(array_agg('\"' 134 | || item.key || '\":\"' 135 | || item.value || '\"'), ',') as json from each(%s) item) || '}' 136 | from %s%s" 137 | column table 138 | (if where-key 139 | (format 140 | " where %s::hstore -> '%s' = '%s'" 141 | column where-key 142 | ;; FIXME - this is ok for ints and such but not strings 143 | (cond 144 | ((stringp where-val) (format "%s" where-val)) 145 | (t where-val))) ""))) 146 | 147 | (defun db-pg/insert (column table values) 148 | (format 149 | "insert into %s (%s) values ('%s')" 150 | table 151 | column 152 | (db-pg/alist->hstore values))) 153 | 154 | (defun db-pg/update (column table values key key-value) 155 | (format 156 | "update %s set %s = '%s' where %s::hstore -> '%s' = '%s'" 157 | table 158 | column 159 | (db-pg/alist->hstore values) 160 | column 161 | key 162 | key-value)) 163 | 164 | (defun db-pg/json-decode (from-str) 165 | "Do the JSON reading." 166 | (let* ((json-key-type 'string)) 167 | (json-read-from-string from-str))) 168 | 169 | (defconst db-pg-log-sql t) 170 | 171 | (defun db-pg/get (keyval db) 172 | "Postgresql key based retrieve." 173 | (let ((db-spec (db-pg/ref->spec db))) 174 | (with-pg-connection con db-spec 175 | (let* (collector 176 | (pg-spec (plist-get db :pg-spec)) 177 | (column (plist-get pg-spec :column)) 178 | (table (plist-get pg-spec :table)) 179 | (key (plist-get pg-spec :key)) 180 | (select-sql 181 | (db-pg/select column table key keyval))) 182 | (when db-pg-log-sql 183 | (with-current-buffer (get-buffer-create 184 | ;; Fixme - want dbname in here as well 185 | (format "*db-pg-%s-%s*" table column)) 186 | (save-excursion 187 | (goto-char (point-max)) 188 | (insert select-sql "\n")))) 189 | (pg:for-each 190 | con select-sql 191 | (lambda (result) 192 | (setq 193 | collector 194 | (append 195 | collector 196 | (list (db-pg/json-decode (caar result))))))) 197 | ;; We only want the first one 198 | (car collector))))) 199 | 200 | (defun db-pg/put (key value db) 201 | (let ((db-spec (db-pg/ref->spec db))) 202 | (with-pg-connection con db-spec 203 | ;; FIXME - what if the key is not in the value? 204 | (let* ((pg-spec (plist-get db :pg-spec)) 205 | (column (plist-get pg-spec :column)) 206 | (table (plist-get pg-spec :table)) 207 | (key-name (plist-get pg-spec :key)) 208 | (select-sql (db-pg/select column table key-name key)) 209 | (result (pg:exec con select-sql)) 210 | (row (pg:result result :tuples))) 211 | (if row 212 | (pg:exec 213 | con 214 | (db-pg/update column table value key-name key)) 215 | ;; Else insert 216 | (pg:exec 217 | con (db-pg/insert column table value))) 218 | ;; Now something to return 219 | (db-pg/get key db))))) 220 | 221 | (defun db-pg/map (func db &optional query filter) 222 | "Call FUNC for every value in DB or just those matching QUERY. 223 | 224 | FILTER causes it " 225 | (let ((db-spec (db-pg/ref->spec db))) 226 | (with-pg-connection con db-spec 227 | ;; FIXME - what if the key is not in the value? 228 | (let* ((pg-spec (plist-get db :pg-spec)) 229 | (column (plist-get pg-spec :column)) 230 | (table (plist-get pg-spec :table)) 231 | (key (plist-get pg-spec :key)) 232 | (select-sql (db-pg/select column table)) 233 | (result (pg:exec con select-sql))) 234 | (loop for (row . rest) in (pg:result result :tuples) 235 | append 236 | (let ((alist (db-pg/json-decode row))) 237 | (funcall func (aget alist key) alist))))))) 238 | 239 | 240 | ;; Ensure the pg stuff is included in the db config 241 | (puthash 'db-pg 'db-pg db/types) 242 | 243 | (provide 'db-pg) 244 | 245 | ;;; db-pg.el ends here 246 | --------------------------------------------------------------------------------