aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorMatthias Andreas Benkard <code@mail.matthias.benkard.de>2012-02-21 20:34:48 +0100
committerMatthias Andreas Benkard <code@mail.matthias.benkard.de>2012-02-21 20:35:13 +0100
commit068b1376463f865c2beade84eb71e1ae590edc42 (patch)
treef6cdefad78272eceb6380c9ad1467b93dddb8b8e /src
Initial checkin.
Diffstat (limited to 'src')
-rw-r--r--src/eu/mulk/instadump.clj100
1 files changed, 100 insertions, 0 deletions
diff --git a/src/eu/mulk/instadump.clj b/src/eu/mulk/instadump.clj
new file mode 100644
index 0000000..5ad56ce
--- /dev/null
+++ b/src/eu/mulk/instadump.clj
@@ -0,0 +1,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"))