3pp-mirror/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-05-11 06:26:38 +02:00
Code Issues Projects Releases Packages Wiki Activity

📎 Add analyze-file helper to srepl.main namespace

Browse source
This commit is contained in:
Andrey Antukh 2022-03-30 15:28:35 +02:00 • committed by Andrés Moya
parent cee85942e6
commit 59d0bafdc9
1 changed files with 43 additions and 80 deletions
Download patch file Download diff file Expand all files Collapse all files

123
backend/src/app/srepl/main.clj
View file

@ -17,10 +17,11 @@
[app.srepl.dev :as dev] [app.srepl.dev :as dev]
[app.util.blob :as blob] [app.util.blob :as blob]
[app.util.time :as dt] [app.util.time :as dt]
[fipp.edn :refer [pprint]]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[clojure.walk :as walk]
[cuerdas.core :as str] [cuerdas.core :as str]
[expound.alpha :as expound])) [expound.alpha :as expound]
[fipp.edn :refer [pprint]]))
(defn update-file (defn update-file
([system id f] (update-file system id f false)) ([system id f] (update-file system id f false))
@ -66,86 +67,48 @@
(db/insert! conn :file params) (db/insert! conn :file params)
(:id file)))))) (:id file))))))
(defn verify-files ;; (defn check-image-shapes
[system {:keys [age sleep chunk-size max-chunks stop-on-error? verbose?] ;; [{:keys [data] :as file} stats]
:or {sleep 1000 ;; (println "=> analizing file:" (:name file) (:id file))
age "72h" ;; (swap! stats update :total-files (fnil inc 0))
chunk-size 10 ;; (let [affected? (atom false)]
verbose? false ;; (walk/prewalk (fn [obj]
stop-on-error? true ;; (when (and (map? obj) (= :image (:type obj)))
max-chunks ##Inf}}] ;; (when-let [fcolor (some-> obj :fill-color str/upper)]
;; (when (or (= fcolor "#B1B2B5")
;; (= fcolor "#7B7D85"))
;; (reset! affected? true)
;; (swap! stats update :affected-shapes (fnil inc 0))
;; (println "--> image shape:" ((juxt :id :name :fill-color :fill-opacity) obj)))))
;; obj)
;; data)
;; (when @affected?
;; (swap! stats update :affected-files (fnil inc 0)))))
(letfn [(retrieve-chunk [conn cursor] (defn analyze-files
(let [sql (str "select id, name, modified_at, data from file " [system {:keys [sleep chunk-size max-chunks on-file]
" where modified_at > ? and deleted_at is null " :or {sleep 1000 chunk-size 10 max-chunks ##Inf}}]
" order by modified_at asc limit ?") (let [stats (atom {})]
age (if cursor (letfn [(retrieve-chunk [conn cursor]
cursor (let [sql (str "select id, name, modified_at, data from file "
(-> (dt/now) (dt/minus age)))] " where modified_at < ? and deleted_at is null "
(seq (db/exec! conn [sql age chunk-size])))) " order by modified_at desc limit ?")]
(->> (db/exec! conn [sql cursor chunk-size])
(map #(update % :data blob/decode)))))
(validate-item [{:keys [id data modified-at] :as file}] (process-chunk [chunk]
(let [data (blob/decode data) (loop [items chunk]
valid? (s/valid? ::spec.file/data data)] (when-let [item (first items)]
(on-file item stats)
(recur (rest items)))))]
(l/debug :hint "validated file"
:file-id id
:age (-> (dt/diff modified-at (dt/now))
(dt/truncate :minutes)
(str)
(subs 2)
(str/lower))
:valid valid?)
(when (and (not valid?) verbose?)
(let [edata (-> (s/explain-data ::spec.file/data data)
(update ::s/problems #(take 5 %)))]
(binding [s/*explain-out* expound/printer]
(l/warn ::l/raw (with-out-str (s/explain-out edata))))))
(when (and (not valid?) stop-on-error?)
(throw (ex-info "penpot/abort" {})))
valid?))
(validate-chunk [chunk]
(loop [items chunk
success 0
errored 0]
(if-let [item (first items)]
(if (validate-item item)
(recur (rest items) (inc success) errored)
(recur (rest items) success (inc errored)))
[(:modified-at (last chunk))
success
errored])))
(fmt-result [ns ne]
{:total (+ ns ne)
:errors ne
:success ns})
]
(try
(db/with-atomic [conn (:app.db/pool system)] (db/with-atomic [conn (:app.db/pool system)]
(loop [cursor nil (loop [cursor (dt/now)
chunks 0 chunks 0]
success 0 (when (< chunks max-chunks)
errors 0] (when-let [chunk (retrieve-chunk conn cursor)]
(if (< chunks max-chunks) (let [cursor (-> chunk last :modified-at)]
(if-let [chunk (retrieve-chunk conn cursor)] (process-chunk chunk)
(let [[cursor success' errors'] (validate-chunk chunk)]
(Thread/sleep (inst-ms (dt/duration sleep))) (Thread/sleep (inst-ms (dt/duration sleep)))
(recur cursor (recur cursor (inc chunks))))))
(inc chunks) @stats))))
(+ success success')
(+ errors errors')))
(fmt-result success errors))
(fmt-result success errors))))
(catch Throwable cause
(when (not= "penpot/abort" (ex-message cause))
(throw cause))
:error))))