Initial commit

Author: Vinai

.gitignore

@@ -0,0 +1,5 @@
+/.cpcache
+/.idea
+/target
+/.nrepl-port
+/.rebel_readline_history

deps.edn

@@ -0,0 +1,6 @@
+{:deps {org.clojure/clojurescript {:mvn/version "1.10.339"}
+        com.bhauman/figwheel-main {:mvn/version "0.1.5"}
+        com.bhauman/rebel-readline-cljs {:mvn/version "0.1.4"}
+        cider/piggieback {:mvn/version "0.3.8"}}
+ :paths ["src" "target" "resources"]
+ :aliases {:build-dev {:main-opts ["-m" "figwheel.main" "-b" "dev" "-r"]}}}

dev.cljs.edn

@@ -0,0 +1,2 @@
+{:main cache.core
+ :target :nodejs}

figwheel-main.edn

@@ -0,0 +1 @@
+{:watch-dirs ["src"]}

readme.md

@@ -0,0 +1,6 @@
+# Magento Cache Cleaner
+
+# Work In Progress!
+
+Small filewatcher to automate selectively cleaning affected cache segments in the Magento 2 file cache backend during development.
+

src/cache/cache.cljs

@@ -0,0 +1,117 @@
+(ns cache.cache
+  (:require [cache.filestorage :as storage]
+            [file.system :as file]
+            [cache.log :as log]
+            [clojure.string :as string]))
+
+(defn cachetype->tag [type]
+  (or
+   (get {"collections" "COLLECTION_DATA"
+         "config_webservices" "WEBSERVICE"
+         "layout" "LAYOUT_GENERAL_CACHE_TAG"
+         "full_page" "FPC"
+         "config_integration_consolidated" "INTEGRATION_CONSOLIDATED"
+         "config_integration_api" "INTEGRATION_API_CONFIG"
+         "config_integration" "INTEGRATION"} type)
+   (string/upper-case type)))
+
+(defn- match-name? [name-pattern file]
+  (cond
+    (regexp? name-pattern) (re-find name-pattern file)
+    :else (= name-pattern (file/basename file))))
+
+(defn- file-fingerprint-fn [name-pattern content-head-pattern]
+  (fn [file]
+    (and (match-name? name-pattern file)
+         (file/exists? file)
+         (or (nil? content-head-pattern)
+             (re-find content-head-pattern (file/head file))))))
+
+(defn- tuples->fingerprint-fns [type tuples]
+  (reduce (fn [acc [filename content]]
+            (assoc acc (file-fingerprint-fn filename content) type)) {} tuples))
+
+(defn- config-filetypes []
+  (let [t [["di.xml" #"urn:magento:framework:ObjectManager/etc/config\.xsd"]
+           ["crontab.xml" #"urn:magento:module:Magento_Cron:etc/crontab\.xsd"]
+           ["events.xml" #"urn:magento:framework:Event/etc/events\.xsd"]
+           ["extension_attributes.xml" #"urn:magento:framework:Api/etc/extension_attributes\.xsd"]
+           ["routes.xml" #"urn:magento:framework:App/etc/routes\.xsd"]
+           ["widget.xml" #"urn:magento:module:Magento_Widget:etc/widget\.xsd"]
+           ["product_types.xml" #"urn:magento:module:Magento_Catalog:etc/product_types\.xsd"]
+           ["product_options.xml" #"urn:magento:module:Magento_Catalog:etc/product_options\.xsd"]
+           ["payment.xml" #"urn:magento:module:Magento_Payment:etc/payment\.xsd"]
+           ["search_request.xml" #"urn:magento:framework:Search/etc/search_request\.xsd"]
+           ["config.xml" #"urn:magento:module:Magento_Store:etc/config\.xsd"]
+           [#"/ui_component/.+\.xml$" #"urn:magento:module:Magento_Ui:etc/ui_configuration\.xsd"]
+           ["menu.xml" #"urn:magento:module:Magento_Backend:etc/menu\.xsd"]
+           ["acl.xml" #"urn:magento:framework:Acl/etc/acl\.xsd"]
+           ["indexer.xml" #"urn:magento:framework:Indexer/etc/indexer\.xsd"]]]
+    (tuples->fingerprint-fns ::config t)))
+
+(defn- layout-filetypes []
+  (let [t [[#"/layout/.+\.xml$" #"<page [^>]+\"urn:magento:framework:View/Layout/etc/page_configuration\.xsd\""]]]
+    (tuples->fingerprint-fns ::layout t)))
+
+(defn- translation-filetypes []
+  (let [t [[#"/i18n/.+\.csv$" #".+,.+"]]]
+    (tuples->fingerprint-fns ::translation t)))
+
+(defn- template-filetypes []
+  (let [t [[#"/templates/.+\.phtml"]]]
+    (tuples->fingerprint-fns ::template t)))
+
+(def file->type
+  (merge (config-filetypes)
+         (layout-filetypes)
+         (translation-filetypes)
+         (template-filetypes)))
+
+(defn- magefile->filetype [file]
+  (reduce (fn [_ [filetype? type]]
+            (when (filetype? file) (reduced type))) nil file->type))
+
+(defn tag->ids [tag]
+  (if (file/exists? (storage/tag->filepath tag))
+    (storage/tag->ids tag)
+    []))
+
+(defn id->file [id]
+  (storage/id->filepath id))
+
+(def filetype->cachetypes
+  {::config ["config"]
+   ::translation ["translate"]
+   ::layout ["layout" "full_page"]
+   ::template ["block_html" "full_page"]})
+
+(defn magefile->cachetypes [file]
+  (let [filetype (magefile->filetype file)]
+    (get filetype->cachetypes filetype [])))
+
+(defn- rm-tagfile [tag]
+  (let [file (storage/tag->filepath tag)]
+    (when (file/exists? file)
+      (file/rm file))))
+
+(defn- clean
+  ([] (storage/clean-all))
+  ([type]
+   (let [tag (cachetype->tag type)]
+     (log/debug "Cleaning tag" tag)
+     (run! storage/delete (tag->ids tag))
+     (rm-tagfile tag)))
+  ([type & types]
+   (run! #(clean %) (into [type] types))))
+
+(defn clean-cache-types [cache-types]
+  (apply log/notice "Cleaning cache type(s)" cache-types)
+  (when (or (empty? cache-types) (not= ["full_page"] cache-types))
+    (log/debug "Using cache dir var/cache...")
+    (binding [storage/*cachedir* "var/cache/"]
+      (let [cache-types (remove #(= "full_page" %) cache-types)]
+        (apply clean cache-types))))
+  (when (or (empty? cache-types) (some #{"full_page"} cache-types))
+    (log/debug "Using cache dir var/page_cache...")
+    (binding [storage/*cachedir* "var/page_cache/"]
+      (clean))))

src/cache/core.cljs

@@ -0,0 +1,100 @@
+(ns cache.core
+  (:require [cache.cache :as cache]
+            [cache.filestorage :as storage]
+            [file.system :as fs]
+            [cache.log :as log]
+            [magento.watcher :as watcher]))
+
+(defn has-switch?
+  "Return true is one of the given opts strings is contained within the args seq"
+  [switches args]
+  (let [matches-switch (set (if (string? switches) #{switches} switches))]
+    (reduce (fn [x arg]
+              (when (matches-switch arg) (reduced true))) nil args)))
+
+(defn find-arg
+  "If args contains one of the given argument switches, returns the next arg in
+  the seq, otherwise returns nil."
+  [flags args]
+  (let [matches-flag (set (if (string? flags) #{flags} flags))]
+    (let [r (reduce (fn [x arg]
+                      (cond
+                        (matches-flag arg) true
+                        x (reduced arg))) nil args)]
+      (if (= true r) nil r))))
+
+(defn find-basedir-in-path [dir]
+  (let [dir (fs/realpath dir)]
+    (if (fs/exists? (str dir "/app/etc/env.php")) dir
+        (let [parent (fs/dirname dir)]
+          (when (not= parent dir)
+            (recur parent))))))
+
+(defn find-basedir-in-args [args]
+  (find-arg ["-d" "--directory"] args))
+
+(defn find-basedir [args]
+  (let [basedir (or (find-basedir-in-args args) (find-basedir-in-path (fs/cwd)))]
+    (when-not basedir
+      (throw (ex-info "Unable to determine Magento directory." {})))
+    (when-not (fs/dir? basedir)
+      (throw (ex-info (str "Magento directory " basedir " does not exist.") {})))
+    (log/info "Magento dir" basedir)
+    basedir))
+
+(defn find-log-level [args]
+  (letfn [(arg->verbosity [arg]
+            (case arg
+              ( "-v" "--verbose") 1
+              ("-vv" "--shout")   2
+              ("-vvv" "--debug")  3
+              0))]
+    (reduce + 0 (map arg->verbosity args))))
+
+(defn help-the-needfull []
+  (println "Usage: clean-cache [options and flags] [cache-types...]
+Clear the given cache types. If none are given, clear all cache types.
+
+--directory|-d <dir>    Magento base directory
+--watch|-w              Watch for file changes
+--verbose|-v            Display cleared cache types
+--shout|-vv             Display more info
+--debug|-vvv            Display too much information
+--help|-h               This help message"))
+
+(defn help-needed? [args]
+  (has-switch? ["-h" "--help"] args))
+
+(defn arg-with-val? [arg]
+  (#{"--directory" "-d"} arg))
+
+(defn switch? [arg]
+  (#{"--watch" "-w"
+     "--verbose" "-v"
+     "--shout" "-vv"
+     "--debug" "-vvv"
+     "--help" "-h" } arg))
+
+(defn remove-switches-and-args-with-vals [args]
+  (let [args (vec args)]
+    (loop [xs [] i 0]
+      (if (= i (count args)) xs
+          (let [arg (get args i)]
+            (cond
+              (arg-with-val? arg) (recur xs (+ i 2))
+              (switch? arg) (recur xs (inc i))
+              :else (recur (conj xs arg) (inc i))))))))
+
+(defn -main [& args]
+  (log/always "Sponsored by https://www.mage2.tv\n")
+  (if (help-needed? args)
+    (help-the-needfull)
+    (do
+      (log/set-verbosity! (find-log-level args))
+      (storage/set-magento-dir! (find-basedir args))
+      (if (has-switch? ["-w" "--watch"] args)
+        (watcher/start)
+        (let [cache-types (remove-switches-and-args-with-vals args)]
+          (cache/clean-cache-types cache-types))))))
+
+(set! *main-cli-fn* -main)

src/cache/filestorage.cljs

@@ -0,0 +1,79 @@
+(ns cache.filestorage
+  (:require [file.system :as file]
+            [cache.log :as log]
+            [clojure.string :as string]))
+
+(def options
+  {:file-name-prefix       "mage"
+   :hashed-directory-level 1})
+
+(def magento-basedir (atom "./"))
+
+(def ^:dynamic *cachedir* "var/cache/")
+
+(def add-trailing-slash
+  (memoize
+   (fn [dir]
+     (if (= \/ (last dir))
+       dir
+       (str dir "/")))))
+
+(defn set-magento-dir! [dir]
+  (reset! magento-basedir dir))
+
+(defn base-dir []
+  (add-trailing-slash @magento-basedir))
+
+(defn- cache-dir []
+  (add-trailing-slash (str (base-dir) *cachedir*)))
+
+(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 (file/realpath (base-dir)) "/app/etc/")) 0 3) "_"))
+
+(defn- chars-from-end [^String s length]
+  (subs s (- (count s) length)))
+
+(defn- path [^String id]
+  (let [length (:hashed-directory-level options)
+        dir    (cache-dir)]
+    (if (< 0 length)
+      (str dir (file-name-prefix) "--" (chars-from-end (md5 (str (cache-id-prefix) id)) length) "/")
+      dir)))
+
+(defn- tag-path []
+  (str (cache-dir) (file-name-prefix) "-tags/"))
+
+(defn id->filename [^String id]
+  (str (file-name-prefix) "---" (cache-id-prefix) id))
+
+(defn id->filepath [^String id]
+  (str (path id) (id->filename id)))
+
+(defn tag->filepath [^String tag]
+  (str (tag-path) (id->filename tag)))
+
+(defn- remove-cache-id-prefix [id-with-prefix]
+  (subs id-with-prefix 4))
+
+(defn tag->ids [tag]
+  (let [file (tag->filepath tag)]
+    (when (file/exists? file)
+      (doall (map remove-cache-id-prefix (string/split-lines (file/slurp file)))))))
+
+(defn clean-all []
+  (log/debug "Cleaning dir" (cache-dir))
+  (file/rm-contents (cache-dir)))
+
+(defn delete [id]
+  (log/debug "Cleaning id" id)
+  (let [file (id->filepath id)]
+    (when (file/exists? file)
+      (file/rm file))))

src/cache/log.cljs

@@ -0,0 +1,35 @@
+(ns cache.log)
+
+(def levels {::debug 3
+             ::info 2
+             ::notice 1
+             ::error 0
+             ::all -1})
+
+(defn- ->level [n]
+  (when (keyword? n)
+    (get levels n)))
+
+(defonce verbosity (atom (->level :error)))
+
+(defn set-verbosity! [v]
+  (reset! verbosity v))
+
+(defn- out [level & msg]
+  (when (>= @verbosity (->level level)
+            (apply println msg))))
+
+(defn debug [msg & msgs]
+  (apply out ::debug msg msgs))
+
+(defn info [msg & msgs]
+  (apply out ::info msg msgs))
+
+(defn notice [msg & msgs]
+  (apply out ::notice msg msgs))
+
+(defn error [msg & msgs]
+  (apply out ::error msg msgs))
+
+(defn always [msg & msgs]
+  (apply out ::all msg msgs))