Introduce additional cache implementation that can use any database

ChangeLog.md

@@ -1,6 +1,18 @@
 ## Changes between 1.5.0 and 1.6.0
 
-No changes yet.
+### One More Cache Implementation
+
+`monger.cache/db-aware-monger-cache-factory` will return a MongoDB-backed `clojure.core.cache`
+implementation that can use any database:
+
+``` clojure
+(require '[monger.cache :as cache])
+
+(let [db   (mg/get-db "altcache")
+      coll "cache_entries"
+      c    (db-aware-monger-cache-factory db coll)]
+  (comment "This cache instance will use the altcache DB"))
+```
 
 
 ## Changes between 1.4.0 and 1.5.0

src/clojure/monger/cache.clj

@@ -4,9 +4,11 @@
       :author "Michael S. Klishin"}
   monger.cache
   (:require [monger.collection  :as mc]
-            [clojure.core.cache :as cache])
-  (:use monger.conversion)
-  (:import clojure.core.cache.CacheProtocol))
+            [clojure.core.cache :as cache]
+            [monger.conversion  :as cnv])
+  (:import clojure.core.cache.CacheProtocol
+           [com.mongodb DB DBObject WriteConcern]
+           java.util.Map))
 
 ;;
 ;; Implementation
@@ -15,6 +17,24 @@
 (def ^{:const true}
   default-cache-collection "cache_entries")
 
+
+(defn- ^DBObject find-one
+  [^DB db ^String collection ^Map ref]
+  (.findOne (.getCollection db (name collection))
+            (cnv/to-db-object ref)))
+
+(defn- find-by-id
+  "A version of monger.collection/find-by-id that does not require the
+   fields argument"
+  [^DB db ^String collection id]
+  (find-one db collection {:_id id}))
+
+(defn- find-map-by-id
+  "A version of monger.collection/find-by-map-id that accepts database
+   as an argument"
+  [^DB db ^String collection id]
+  (cnv/from-db-object ^DBObject (find-one db collection {:_id id}) true))
+
 ;;
 ;; API
 ;;
@@ -24,11 +44,8 @@
 (extend-protocol cache/CacheProtocol
   BasicMongerCache
   (lookup [c k]
-    (:value (mc/find-map-by-id (:collection c) k)))
-  #_ (lookup [c k not-found]
-    (if-let [doc (mc/find-map-by-id (:collection c) k)]
-      (:value doc)
-      not-found))
+    (let [m (mc/find-map-by-id (:collection c) k)]
+      (:value m)))
   (has? [c k]
     (not (nil? (mc/find-by-id (get c :collection) k))))
   (hit [this k]
@@ -52,3 +69,35 @@
      (BasicMongerCache. collection))
   ([collection base]
      (cache/seed (BasicMongerCache. collection) base)))
+
+
+(defrecord DatabaseAwareMongerCache [db collection])
+
+(extend-protocol cache/CacheProtocol
+  DatabaseAwareMongerCache
+  (lookup [c k]
+    (let [m (find-map-by-id (:db c) (:collection c) k)]
+      (:value m)))
+  (has? [c k]
+    (not (nil? (find-by-id (:db c) (:collection c) k))))
+  (hit [this k]
+    this)
+  (miss [c k v]
+    (mc/insert (:db c) (:collection c) {:_id k :value v} WriteConcern/SAFE)
+    c)
+  (evict [c k]
+    (mc/remove-by-id (:db c) (:collection c) k)
+    c)
+  (seed [c m]
+    (mc/insert-batch (:db c) (:collection c) (map (fn [[k v]]
+                                                    {:_id k :value v}) m) WriteConcern/SAFE)
+    c))
+
+
+(defn db-aware-monger-cache-factory
+  ([db]
+     (DatabaseAwareMongerCache. db default-cache-collection))
+  ([db collection]
+     (DatabaseAwareMongerCache. db collection))
+  ([db collection base]
+     (cache/seed (DatabaseAwareMongerCache. db collection) base)))

test/monger/test/cache_test.clj

@@ -1,5 +1,6 @@
 (ns monger.test.cache-test
   (:require [monger.test.helper :as helper]
+            [monger.core        :as mg]
             [monger.collection  :as mc])
   (:use clojure.core.cache clojure.test monger.cache)
   (:import [clojure.core.cache BasicCache FIFOCache LRUCache TTLCache]
@@ -121,3 +122,42 @@
            "Value"   :skey
            l         :lkey
            "keyword" "kkey"))))
+
+
+(deftest ^{:cache true}
+  test-has?-with-db-aware-monger-cache
+  (testing "that has? returns false for misses"
+    (let [db   (mg/get-db "altcache")
+          coll "db_aware_monger_cache_entries"
+          c    (db-aware-monger-cache-factory db coll)]
+      (is (not (has? c (str (UUID/randomUUID)))))
+      (is (not (has? c (str (UUID/randomUUID)))))))
+  (testing "that has? returns true for hits"
+    (let [db   (mg/get-db "altcache")
+          coll "db_aware_monger_cache_entries"
+          c    (db-aware-monger-cache-factory db coll {"a" 1 "b" "cache" "c" 3/4})]
+      (is (has? c "a"))
+      (is (has? c "b"))
+      (is (has? c "c"))
+      (is (not (has? c "d"))))))
+
+
+(deftest ^{:cache true}
+  test-lookup-with-basic-moger-cache
+  (testing "that lookup returns nil for misses"
+    (let [db   (mg/get-db "altcache")
+          coll "db_aware_monger_cache_entries"
+          c    (db-aware-monger-cache-factory db coll)]
+      (are [v] (is (nil? (lookup c v)))
+           :missing-key
+           "missing-key"
+           (gensym "missing-key"))))
+  (testing "that lookup returns cached values for hits"
+    (let [l (Long/valueOf 10000)
+          db   (mg/get-db "altcache")
+          coll "db_aware_monger_cache_entries"
+          c    (db-aware-monger-cache-factory db coll {:skey "Value" :lkey l "kkey" :keyword})]
+      (are [v k] (is (= v (lookup c k)))
+           "Value"   :skey
+           l         :lkey
+           "keyword" "kkey"))))