blob: d0f922a980a547e3ab13eccc577be0ba073f868a (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
|
(ns mulk.benki.db
(:refer-clojure)
(:use mulk.benki.util
clojure.java.io)
(:import [com.sleepycat.je
Database DatabaseConfig DatabaseEntry Environment EnvironmentConfig
OperationStatus]))
(def ^{:dynamic true :private true} *txn*)
(def ^{:dynamic true :private true} *db*)
(defn- db-directory []
;; FIXME: This is a hack.
;;(file (.getParent (first (clojure.java.classpath/classpath))) "db")
(file "db"))
(defn- make-db-env []
(let [envconfig (doto (EnvironmentConfig.)
(.setTransactional true)
(.setAllowCreate true)
(.setTxnSerializableIsolation true))]
(Environment. (db-directory) envconfig)))
(defonce dbenv (make-db-env))
(defn call-with-transaction [thunk]
(binding [*txn* (.beginTransaction dbenv nil nil)]
(try (let [result (thunk)]
(.commit *txn*)
result)
(finally (.abort *txn*)))))
(defn call-with-db [thunk]
(let [dbconfig (doto (DatabaseConfig.)
(.setTransactional true)
(.setAllowCreate true)
(.setSortedDuplicates false))]
(call-with-transaction
(fn []
(binding [*db* (.openDatabase dbenv *txn* "benki" dbconfig)]
(thunk))))))
(defmacro with-db [& body]
`(call-with-db (fn [] ~@body)))
(defn- dump-str-for-db [x]
(binding [*print-dup* true
*print-meta* true]
(pr-str x)))
(defn- getkey [key default]
(let [entry (DatabaseEntry.)]
(if (= (.get *db* *txn* (DatabaseEntry. (.getBytes key)) entry nil)
OperationStatus/SUCCESS)
(-> entry
(.getData)
(String.)
(read-string))
default)))
(defn- putkey [key val]
(let [bdbkey key]
(.put *db*
*txn*
(DatabaseEntry. (.getBytes bdbkey))
(DatabaseEntry. (.getBytes (dump-str-for-db val))))))
(defonce state-vars (atom {}))
(defmacro defstate [sym default]
(let [dbkey (str *ns* "/" (name sym))]
`(defonce ~sym
(let [r# (ref (with-db (getkey ~dbkey ~default)))]
(swap! state-vars #(assoc % ~dbkey r#))
r#))))
(defn save-all-global-state! []
(with-db
(dosync
(doseq [[key r] @state-vars]
(putkey key (ensure r))))))
(defn reload-all-global-state! []
(with-db
(dosync
(doseq [[key r] @state-vars]
(alter r #(getkey key %))))))
|