Add redis cache storage support

Author: Vinai

build.cljs.edn

@@ -1,4 +1,4 @@
-{:main cache.core
+{:main cache.run
  :target :nodejs
  :infer-externs true
  :npm-deps {:redis "2.8.0"}

dev.cljs.edn

@@ -1,4 +1,4 @@
-{:main cache.cache
+{:main cache.core
  :target :nodejs
  :npm-deps {:redis "2.8.0"}
  :install-deps true}

src/cache/cache.cljs

@@ -36,9 +36,10 @@
 (defn- clean
   ([cache] (storage/clean-all cache))
   ([cache type]
-   (let [tag (cachetype->tag type)]
+   (let [tag (cachetype->tag type)
+         prefixed-tag (str (storage/magento-instance-cache-id-prefix) tag)]
      (log/debug "Cleaning tag" tag)
-     (storage/clean-tag cache tag)))
+     (storage/clean-tag cache prefixed-tag)))
   ([cache type & types]
    (run! #(clean cache %) (into [type] types))))
 
@@ -52,9 +53,6 @@
       (redis/create config)
       (file/create config))))
 
-(defn tag->ids [cache tag]
-  (storage/tag->ids cache tag))
-
 (defn clean-cache-types [cache-types]
   (if (seq cache-types)
     (apply log/notice "Cleaning cache type(s)" cache-types)

src/cache/core.cljs

@@ -114,5 +114,3 @@ Clean the given cache types. If none are given, clean all cache types.
            (binding [*print-fn* *print-err-fn*]
              (println "[ERROR]" (or (.-message e) e)))
            (exit-with-code 1)))))
-
-(set! *main-cli-fn* -main)

src/cache/run.cljs

@@ -0,0 +1,7 @@
+(ns cache.run
+  (:require [cache.core]))
+
+(defn -main [& args]
+  (apply cache.core/-main args))
+
+(set! *main-cli-fn* -main)

src/cache/storage.cljs

@@ -1,7 +1,14 @@
-(ns cache.storage)
+(ns cache.storage
+  (:require [magento.app :as mage]
+            [file.system :as fs]))
+
+(defn md5 [^String data]
+  (let [crypto (js/require "crypto")]
+    (-> crypto (.createHash "md5") (.update data) (.digest "hex"))))
+
+(defn magento-instance-cache-id-prefix []
+  (str (subs (md5 (str (fs/realpath (mage/base-dir)) "/app/etc/")) 0 3) "_"))
 
 (defprotocol CacheStorage
-  (tag->ids [storage tag] "Takes a cache tag and returns a seq of ids associated with the tag.")
-  (delete [storage id] "Deletes the cache record with the given ID")
   (clean-tag [storage tag] "Deletes all cache records associated with the given tag.")
   (clean-all [storage] "Delete all cache records and tags."))

src/cache/storage/file.cljs

@@ -9,61 +9,51 @@
   {:file-name-prefix       "mage"
    :hashed-directory-level 1})
 
-(defn- md5 [^String data]
-  (let [crypto (js/require "crypto")]
-    (-> crypto (.createHash "md5") (.update data) (.digest "hex"))))
-
 (defn- file-name-prefix []
   (:file-name-prefix options))
 
-(defn- cache-id-prefix []
-  (str (subs (md5 (str (fs/realpath (mage/base-dir)) "/app/etc/")) 0 3) "_"))
-
 (defn- chars-from-end [^String s length]
   (subs s (- (count s) length)))
 
 (defn- path [^String cache-dir ^String id]
   (let [length (:hashed-directory-level options)]
     (if (< 0 length)
-      (let [suffix (chars-from-end (md5 (str (cache-id-prefix) id)) length)]
+      (let [suffix (chars-from-end (storage/md5 id) length)]
         (str cache-dir (file-name-prefix) "--" suffix "/"))
       cache-dir)))
 
 (defn- tag-path [cache-dir]
   (str cache-dir (file-name-prefix) "-tags/"))
 
 (defn- id->filename [^String id]
-  (str (file-name-prefix) "---" (cache-id-prefix) id))
+  (str (file-name-prefix) "---" id))
 
 (defn- id->filepath [^String cache-dir ^String id]
   (str (path cache-dir id) (id->filename id)))
 
 (defn- tag->filepath [^String cache-dir ^String tag]
   (str (tag-path cache-dir) (id->filename tag)))
 
-(defn- remove-cache-id-prefix [id-with-prefix]
-  (subs id-with-prefix 4))
+(defn- tag->ids [cache-dir tag]
+  (let [file (tag->filepath cache-dir tag)]
+    (if (fs/exists? file)
+      (string/split-lines (fs/slurp file))
+      [])))
+
+(defn- delete [cache-dir id]
+  (log/debug "Cleaning id" id)
+  (let [file (id->filepath cache-dir id)]
+    (when (fs/exists? file)
+      (fs/rm file))))
 
 (defrecord File [cache-dir]
   storage/CacheStorage
 
-  (tag->ids [this tag]
-    (let [file (tag->filepath cache-dir tag)]
-      (if (fs/exists? file)
-        (doall (map remove-cache-id-prefix (string/split-lines (fs/slurp file))))
-        [])))
-
-  (delete [this id]
-    (log/debug "Cleaning id" id)
-    (let [file (id->filepath cache-dir id)]
-      (when (fs/exists? file)
-        (fs/rm file))))
-
   (clean-tag [this tag]
     (let [tag-file (tag->filepath cache-dir tag)]
       (log/debug "Tag-file" tag-file)
       (when (fs/exists? tag-file)
-        (run! #(storage/delete this %) (storage/tag->ids this tag))
+        (run! #(delete cache-dir %) (tag->ids cache-dir tag))
         (fs/rm tag-file))))
 
   (clean-all [this]

src/cache/storage/redis.cljs

@@ -1,22 +1,60 @@
 (ns cache.storage.redis
-  (:require [cache.storage :as storage]
-            [log.log :as log]))
+  (:require [file.system :as fs]
+            [magento.app :as mage]
+            [cache.storage :as storage]
+            [log.log :as log]
+            [clojure.string :as string]))
 
-(defrecord Redis [config]
-  storage/CacheStorage
+(defonce redis (js/require "redis"))
+
+(def ^:const set-ids "zc:ids")
+(def ^:const set-tags "zc:tags")
+(def ^:const prefix-key "zc:k:")
+(def ^:const prefix-tag-id "zc:ti:")
+
+(defn- localhost? [host]
+  (#{"localhost" "127.0.0.1"} host))
+
+(defn- default-port? [port]
+  (= "6379" port))
 
-  (tag->ids [this tag]
-    [])
+(defn- connect-db [config]
+  (or (-> config :backend_options :database) 0))
 
-  (delete [this id]
-    )
+(defn- connect-options [config]
+  (let [{:keys [server port password]} (:backend_options config)
+        database (connect-db config)]
+    (cond-> {}
+      (and server (not (localhost? server))) (assoc :host server)
+      (and port (not (default-port? port))) (assoc :port port)
+      password (assoc :auth_pass password)
+      database (assoc :db database))))
+
+(defn- tag->ids [client tag callback]
+  (.smembers client (str prefix-tag-id tag)
+             (fn [err ids]
+               (callback ids))))
+
+(defn- delete-tag-and-ids [client tag ids]
+  ;; TODO: make multi command
+  (run! #(log/debug "Cleaning id" %) ids)
+  (.del client (doall (map #(str prefix-key %) ids)))
+  (.srem client set-ids ids)
+  (.del client (str prefix-tag-id tag))
+  (.srem client set-tags tag))
+
+(defrecord Redis [client database]
+  storage/CacheStorage
 
   (clean-tag [this tag]
-    )
+    (let [callback (partial delete-tag-and-ids client tag)]
+      (tag->ids client tag callback)))
 
   (clean-all [this]
-    ))
+    (log/debug "Flushing redis db" database)
+    (.flushdb client)))
 
 (defn create [config]
-  (log/error "[Error] REDIS cache storage not yet supported.")
-  (->Redis config))
+  (let [options (connect-options config)
+        client (.createClient redis (clj->js options))]
+    (->Redis client (connect-db config))))