Memoize directory contents with expiry of ten minutes

2 files changed, 33 insertions, 1 deletions

diff --git a/src/site.clj b/src/site.clj
index 5253f88..297f4a5 100644
--- a/src/site.clj
+++ b/src/site.clj
@@ -616,10 +616,14 @@ WHERE  u.user_id = ANY(?)
   (map process-directory-entry
        (add-recent-posts
         (get-user-ranking offset *per-directory-page*))))
+
+(def directory-cache-ttl (minutes 10))
+(def memoized-get-directory-info
+     (ttl-memoize get-directory-info directory-cache-ttl))
     
 (defn directory [session offset]
   (let [st     (fetch-template "directory" session)
-        users  (get-directory-info offset)]
+        users  (memoized-get-directory-info offset)]
     (.setAttribute st "users" users)
     (cond (= offset 0) (.setAttribute st "prev" false)
           (= offset 1) (.setAttribute st "prev" "")
diff --git a/src/utils.clj b/src/utils.clj
index b315bb3..7f56f61 100755
--- a/src/utils.clj
+++ b/src/utils.clj
@@ -370,3 +370,31 @@
   "Evaluates expr if user is super-vip otherwise returns 404. Can only be used
    where session is defined."
   `(if (is-super-vip? ~'session) ~e (unknown-page)))
+
+
+;; Time-expiry memoize
+;; http://www.mail-archive.com/clojure@googlegroups.com/msg20038.html
+
+(defn expire-cached-results* [cached-results time-to-live]
+  "Expire items from the cached function results."
+  (into {}
+    (filter (fn [[k v]]
+      (> time-to-live
+        (- (System/currentTimeMillis) (:time v)))) cached-results)))
+
+(defn ttl-memoize
+  "Returns a memoized version of a referentially transparent function. The
+  memoized version of the function keeps a cache of the mapping from arguments
+  to results and, when calls with the same arguments are repeated often, has
+  higher performance at the expense of higher memory use. Cached results are
+  removed from the cache when their time to live value expires."
+  [function time-to-live]
+  (let [cached-results (atom {})]
+    (fn [& arguments]
+      (swap! cached-results expire-cached-results* time-to-live)
+      (if-let [entry (find @cached-results arguments)]
+        (:result (val entry))
+        (let [result (apply function arguments)]
+          (swap! cached-results assoc arguments
+            { :result result :time (System/currentTimeMillis)})
+          result)))))
\ No newline at end of file