Skip to content

Commit a13ed74

Browse files
committed
Added idle-timeout to refresh cached objects
Removed temporary swap file
1 parent 0c1bbb3 commit a13ed74

2 files changed

Lines changed: 98 additions & 10 deletions

File tree

src/pool/cache.clj

Lines changed: 28 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,19 @@
33

44
(defn- ignore [o & more])
55

6+
(declare purge)
7+
8+
(defn- isSnoring?
9+
; Checks if the element has reached the idle-timeout
10+
[celem idle-timeout]
11+
(if (empty? celem) false
12+
(and (> idle-timeout -1) (>= (- (System/currentTimeMillis) (:ts celem)) idle-timeout))))
13+
14+
(defn- touch-elem
15+
; Updates timestamp for element
16+
[cache elem key]
17+
((swap! cache assoc key (assoc elem :ts (System/currentTimeMillis))) key))
18+
619
(defmacro shutdown-hook
720
[& body]
821
`(.addShutdownHook (Runtime/getRuntime) (Thread. (fn [] ~@body))))
@@ -12,9 +25,10 @@
1225
Safeguards against multiple threads trying to create object for same key.
1326
Take a single arity function @make-fn takes key for object creation which.
1427
Other optional kwarg are
15-
:destroy double arity function which take key and object."
16-
[make-fn & {:keys [destroy] :or {destroy ignore}}]
17-
(let [cache {:cache (atom {}) :make make-fn :destroy destroy}]
28+
:destroy double arity function which take key and object.
29+
:idle-timeout time in millis to refresh idle objects. -1 to ignore"
30+
[make-fn & {:keys [destroy idle-timeout] :or {destroy ignore idle-timeout -1}}]
31+
(let [cache {:cache (atom {}) :make make-fn :destroy destroy :idle-timeout idle-timeout}]
1832
(shutdown-hook
1933
(doseq [[key object] @(:cache cache)]
2034
(destroy key object)))
@@ -24,14 +38,18 @@
2438
"Get object associated with @key from @cache."
2539
[cache key]
2640
(let [cache* (:cache cache)
27-
make-fn (:make cache)]
41+
make-fn (:make cache)
42+
idle-timeout (:idle-timeout cache)
43+
celem (@cache* key)]
2844
; Double-Checked-Locking works as atom works like a volatile here.
29-
(if-let [object (@cache* key)]
30-
object
45+
(if (and celem (not (isSnoring? celem idle-timeout)))
46+
(:elem (touch-elem cache* celem key))
3147
(locking cache
32-
(if-let [object (@cache* key)]
33-
object
34-
((swap! cache* assoc key (make-fn key)) key))))))
48+
(let [celem (@cache* key)]
49+
(if (and celem (not (isSnoring? celem idle-timeout)))
50+
(:elem (touch-elem cache* celem key))
51+
(do (when (isSnoring? celem idle-timeout) (purge cache key))
52+
(:elem ((swap! cache* assoc key {:elem (make-fn key) :ts (System/currentTimeMillis)}) key)))))))))
3553

3654
(defn purge
3755
[cache key]
@@ -44,4 +62,4 @@
4462

4563
(defn exists?
4664
[cache key]
47-
((-> cache :cache deref) key))
65+
(:elem ((-> cache :cache deref) key)))

test/pool/cache_test.clj

Lines changed: 70 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,70 @@
1+
(ns pool.cache-test
2+
(:require [clojure.test :refer :all]
3+
[pool.cache :as c]))
4+
5+
; Initialize Cache
6+
(def cache
7+
(c/get-cache
8+
(fn [k] (let [ts (System/currentTimeMillis)]
9+
(println (str "Inititalized: " k " at: " ts)) ts))
10+
:destroy (fn [k v] (println "Destroyed: " k) true)))
11+
12+
; Initialize Cache with idle timeout
13+
(def icache
14+
(c/get-cache
15+
(fn [k] (let [ts (System/currentTimeMillis)]
16+
(println (str "Inititalized: " k " at: " ts)) ts))
17+
:destroy (fn [k v] (println "Destroyed: " k) true) :idle-timeout 2000))
18+
19+
(deftest test-cache
20+
; Should be possible to add new elements
21+
(let [ts (c/get cache "first")]
22+
; Basic check for value
23+
(is (>= (System/currentTimeMillis) ts))
24+
; create drift
25+
(Thread/sleep 500)
26+
; Same element key should not be re-initialized
27+
(is (= ts (c/get cache "first")))
28+
; Added element should be present
29+
(is (= ts (c/exists? cache "first")))
30+
; Should be possible to drop existing element
31+
(is (= {} (c/purge cache "first")))
32+
; Object should no longer exist
33+
(is (nil? (c/exists? cache "first")))
34+
; Purge should be a no-op
35+
(is (nil? (c/purge cache "first")))))
36+
37+
(deftest idle-timeout
38+
; Should be possible to add new elements
39+
(let [lts (c/get icache "leech")
40+
bts (c/get icache "bird")]
41+
; Basic check for value
42+
(is (>= (System/currentTimeMillis) lts))
43+
(is (>= (System/currentTimeMillis) bts))
44+
; create drift
45+
(Thread/sleep 500)
46+
; Added element should be present and not re-initialized
47+
(is (= lts (c/exists? icache "leech")))
48+
(is (= lts (c/get icache "leech")))
49+
(is (= bts (c/exists? icache "bird")))
50+
(is (= bts (c/get icache "bird")))
51+
(Thread/sleep 1000)
52+
; Same element key should not be re-initialized
53+
; but access timestamp should be updated
54+
(is (= lts (c/get icache "leech")))
55+
(Thread/sleep 1000)
56+
; Accessed element should be present
57+
(is (= lts (c/exists? icache "leech")))
58+
; Accessed element should not be re-initialized
59+
(is (= lts (c/exists? icache "leech")))
60+
; Bird should be re-initialized
61+
(is (< bts (c/get icache "bird")))
62+
; Should be possible to drop existing element
63+
(is (c/purge icache "leech"))
64+
(is (c/purge icache "bird"))
65+
; Object should no longer exist
66+
(is (nil? (c/exists? icache "leech")))
67+
(is (nil? (c/exists? icache "bird")))
68+
; Purge should be a no-op
69+
(is (nil? (c/purge cache "leech")))
70+
(is (nil? (c/purge cache "bird")))))

0 commit comments

Comments
 (0)