aboutsummaryrefslogtreecommitdiff
path: root/src/eu/mulk/instadump.clj
blob: fffc29e230800783ded83399f51bc7c40d518461 (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
91
92
93
94
95
96
97
98
99
100
;; Copyright 2012, Matthias Andreas Benkard.
;; See file COPYING for license details.

(ns eu.mulk.instadump
  (:refer-clojure)
  (:use clojure.java.io)
  (:import [com.sleepycat.je
            Database DatabaseConfig DatabaseEntry Environment EnvironmentConfig
            OperationStatus]))


;;;; * Internal stuff
(def ^{:dynamic true :private true} *txn*)
(def ^{:dynamic true :private true} *db*)

(declare ^{:private true} dbenv)


(defn- make-db-env [db-directory-name]
  (let [envconfig (doto (EnvironmentConfig.)
                    (.setTransactional            true)
                    (.setAllowCreate              true)
                    (.setTxnSerializableIsolation true))]
    (Environment. (file db-directory-name) envconfig)))

(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 ^{:private true} dbenv (atom nil))
(defonce ^{:private true} state-vars (atom {}))


;;;; * Public API
(defn setup-instadump! [dirname]
  (reset! dbenv (make-db-env dirname)))

(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 %))))))

(comment
  (setup-instadump! "db")
  (defstate testvar1 150)
  (defstate testvar2 "abc"))