Added idle-timeout to refresh cached objects

src/pool/cache.clj

@@ -3,6 +3,19 @@
 
 (defn- ignore [o & more])
 
+(declare purge)
+
+(defn- is-snoring?
+  ; Checks if the element has reached the idle-timeout
+  [celem idle-timeout]
+  (if (empty? celem) false
+    (and (> idle-timeout -1) (>= (- (System/currentTimeMillis) (:ts celem)) idle-timeout))))
+
+(defn- touch-elem
+  ; Updates timestamp for element
+  [cache elem key]
+  ((swap! cache assoc key (assoc elem :ts (System/currentTimeMillis))) key))
+
 (defmacro shutdown-hook
   [& body]
   `(.addShutdownHook (Runtime/getRuntime) (Thread. (fn [] ~@body))))
@@ -12,9 +25,10 @@
   Safeguards against multiple threads trying to create object for same key.
   Take a single arity function @make-fn takes key for object creation which.
   Other optional kwarg are
-  :destroy double arity function which take key and object."
-  [make-fn & {:keys [destroy] :or {destroy ignore}}]
-  (let [cache {:cache (atom {}) :make make-fn :destroy destroy}]
+  :destroy double arity function which take key and object.
+  :idle-timeout time in millis to refresh idle objects. -1 to ignore"
+  [make-fn & {:keys [destroy idle-timeout] :or {destroy ignore idle-timeout -1}}]
+  (let [cache {:cache (atom {}) :make make-fn :destroy destroy :idle-timeout idle-timeout}]
     (shutdown-hook
       (doseq [[key object] @(:cache cache)]
         (destroy key object)))
@@ -24,14 +38,18 @@
   "Get object associated with @key from @cache."
   [cache key]
   (let [cache* (:cache cache)
-        make-fn (:make cache)]
+        make-fn (:make cache)
+        idle-timeout (:idle-timeout cache)
+        celem (@cache* key)]
     ; Double-Checked-Locking works as atom works like a volatile here.
-    (if-let [object (@cache* key)]
-      object
+    (if (and celem (not (is-snoring? celem idle-timeout)))
+      (:elem (touch-elem cache* celem key))
       (locking cache
-        (if-let [object (@cache* key)]
-          object
-          ((swap! cache* assoc key (make-fn key)) key))))))
+        (let [celem (@cache* key)]
+          (if (and celem (not (is-snoring? celem idle-timeout)))
+            (:elem (touch-elem cache* celem key))
+            (do (when (is-snoring? celem idle-timeout) (purge cache key))
+                (:elem ((swap! cache* assoc key {:elem (make-fn key) :ts (System/currentTimeMillis)}) key)))))))))
 
 (defn purge
   [cache key]
@@ -44,4 +62,4 @@
 
 (defn exists?
   [cache key]
-  ((-> cache :cache deref) key))
+  (:elem ((-> cache :cache deref) key)))

test/pool/cache_test.clj

@@ -0,0 +1,70 @@
+(ns pool.cache-test
+  (:require [clojure.test :refer :all]
+            [pool.cache :as c]))
+
+; Initialize Cache
+(def cache
+  (c/get-cache
+    (fn [k] (let [ts (System/currentTimeMillis)]
+              (println (str "Inititalized: " k " at: " ts)) ts))
+    :destroy (fn [k v] (println "Destroyed: " k) true)))
+
+; Initialize Cache with idle timeout
+(def icache
+  (c/get-cache
+    (fn [k] (let [ts (System/currentTimeMillis)]
+              (println (str "Inititalized: " k " at: " ts)) ts))
+    :destroy (fn [k v] (println "Destroyed: " k) true) :idle-timeout 2000))
+
+(deftest test-cache
+  ; Should be possible to add new elements
+  (let [ts (c/get cache "first")]
+    ; Basic check for value
+    (is (>= (System/currentTimeMillis) ts))
+    ; create drift
+    (Thread/sleep 500)
+    ; Same element key should not be re-initialized
+    (is (= ts (c/get cache "first")))
+    ; Added element should be present
+    (is (= ts (c/exists? cache "first")))
+    ; Should be possible to drop existing element
+    (is (= {} (c/purge cache "first")))
+    ; Object should no longer exist
+    (is (nil? (c/exists? cache "first")))
+    ; Purge should be a no-op
+    (is (nil? (c/purge cache "first")))))
+
+(deftest idle-timeout
+  ; Should be possible to add new elements
+  (let [lts (c/get icache "leech")
+        bts (c/get icache "bird")]
+    ; Basic check for value
+    (is (>= (System/currentTimeMillis) lts))
+    (is (>= (System/currentTimeMillis) bts))
+    ; create drift
+    (Thread/sleep 500)
+    ; Added element should be present and not re-initialized
+    (is (= lts (c/exists? icache "leech")))
+    (is (= lts (c/get icache "leech")))
+    (is (= bts (c/exists? icache "bird")))
+    (is (= bts (c/get icache "bird")))
+    (Thread/sleep 1000)
+    ; Same element key should not be re-initialized
+    ; but access timestamp should be updated
+    (is (= lts (c/get icache "leech")))
+    (Thread/sleep 1000)
+    ; Accessed element should be present
+    (is (= lts (c/exists? icache "leech")))
+    ; Accessed element should not be re-initialized
+    (is (= lts (c/exists? icache "leech")))
+    ; Bird should be re-initialized
+    (is (< bts (c/get icache "bird")))
+    ; Should be possible to drop existing element
+    (is (c/purge icache "leech"))
+    (is (c/purge icache "bird"))
+    ; Object should no longer exist
+    (is (nil? (c/exists? icache "leech")))
+    (is (nil? (c/exists? icache "bird")))
+    ; Purge should be a no-op
+    (is (nil? (c/purge cache "leech")))
+    (is (nil? (c/purge cache "bird")))))