mirror of
https://github.com/penpot/penpot.git
synced 2025-05-20 18:56:12 +02:00
1074 lines
45 KiB
Clojure
1074 lines
45 KiB
Clojure
;; This Source Code Form is subject to the terms of the Mozilla Public
|
|
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
|
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
|
;;
|
|
;; Copyright (c) KALEIDOS INC
|
|
|
|
(ns app.features.components-v2
|
|
(:require
|
|
[app.common.data :as d]
|
|
[app.common.data.macros :as dm]
|
|
[app.common.exceptions :as ex]
|
|
[app.common.files.changes :as cp]
|
|
[app.common.files.changes-builder :as fcb]
|
|
[app.common.files.helpers :as cfh]
|
|
[app.common.files.libraries-helpers :as cflh]
|
|
[app.common.files.migrations :as fmg]
|
|
[app.common.files.shapes-helpers :as cfsh]
|
|
[app.common.files.validate :as cfv]
|
|
[app.common.geom.point :as gpt]
|
|
[app.common.geom.rect :as grc]
|
|
[app.common.geom.shapes :as gsh]
|
|
[app.common.logging :as l]
|
|
[app.common.math :as mth]
|
|
[app.common.schema :as sm]
|
|
[app.common.svg :as csvg]
|
|
[app.common.svg.shapes-builder :as sbuilder]
|
|
[app.common.types.color :as ctc]
|
|
[app.common.types.component :as ctk]
|
|
[app.common.types.components-list :as ctkl]
|
|
[app.common.types.container :as ctn]
|
|
[app.common.types.file :as ctf]
|
|
[app.common.types.pages-list :as ctpl]
|
|
[app.common.types.shape :as cts]
|
|
[app.common.types.shape-tree :as ctst]
|
|
[app.common.uuid :as uuid]
|
|
[app.db :as db]
|
|
[app.db.sql :as sql]
|
|
[app.features.fdata :as fdata]
|
|
[app.http.sse :as sse]
|
|
[app.media :as media]
|
|
[app.rpc.commands.files :as files]
|
|
[app.rpc.commands.files-snapshot :as fsnap]
|
|
[app.rpc.commands.media :as cmd.media]
|
|
[app.storage :as sto]
|
|
[app.storage.tmp :as tmp]
|
|
[app.svgo :as svgo]
|
|
[app.util.blob :as blob]
|
|
[app.util.cache :as cache]
|
|
[app.util.pointer-map :as pmap]
|
|
[app.util.time :as dt]
|
|
[buddy.core.codecs :as bc]
|
|
[cuerdas.core :as str]
|
|
[datoteka.io :as io]
|
|
[promesa.exec :as px]
|
|
[promesa.util :as pu]))
|
|
|
|
(def ^:dynamic *stats*
|
|
"A dynamic var for setting up state for collect stats globally."
|
|
nil)
|
|
|
|
(def ^:dynamic *cache*
|
|
"A dynamic var for setting up a cache instance."
|
|
nil)
|
|
|
|
(def ^:dynamic *skip-on-graphic-error*
|
|
"A dynamic var for setting up the default error behavior for graphics processing."
|
|
nil)
|
|
|
|
(def ^:dynamic ^:private *system*
|
|
"An internal var for making the current `system` available to all
|
|
internal functions without the need to explicitly pass it top down."
|
|
nil)
|
|
|
|
(def ^:dynamic ^:private *team-id*
|
|
"A dynamic var that holds the current processing team-id."
|
|
nil)
|
|
|
|
(def ^:dynamic ^:private *file-stats*
|
|
"An internal dynamic var for collect stats by file."
|
|
nil)
|
|
|
|
(def ^:dynamic ^:private *team-stats*
|
|
"An internal dynamic var for collect stats by team."
|
|
nil)
|
|
|
|
(def grid-gap 50)
|
|
(def frame-gap 200)
|
|
(def max-group-size 50)
|
|
|
|
(defn decode-row
|
|
[{:keys [features data] :as row}]
|
|
(cond-> row
|
|
(some? features)
|
|
(assoc :features (db/decode-pgarray features #{}))
|
|
|
|
(some? data)
|
|
(assoc :data (blob/decode data))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; FILE PREPARATION BEFORE MIGRATION
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defn- prepare-file-data
|
|
"Apply some specific migrations or fixes to things that are allowed in v1 but not in v2,
|
|
or that are the result of old bugs."
|
|
[file-data libraries]
|
|
(let [detached-ids (volatile! #{})
|
|
|
|
detach-shape
|
|
(fn [container shape]
|
|
;; Detach a shape. If it's inside a component, add it to detached-ids, for further use.
|
|
(let [is-component? (let [root-shape (ctst/get-shape container (:id container))]
|
|
(and (some? root-shape) (nil? (:parent-id root-shape))))]
|
|
(when is-component?
|
|
(vswap! detached-ids conj (:id shape)))
|
|
(ctk/detach-shape shape)))
|
|
|
|
fix-misc-shape-issues
|
|
(fn [file-data]
|
|
;; Find shapes that are not listed in their parent's children list.
|
|
;; Remove them, and also their children
|
|
(let [update-shape
|
|
(fn [shape]
|
|
(cond-> shape
|
|
;; Some shapes has invalid value there
|
|
(contains? shape :layout-gap)
|
|
(d/update-in-when [:layout-gap :column-gap]
|
|
(fn [gap]
|
|
(if (or (= gap ##Inf)
|
|
(= gap ##-Inf))
|
|
0
|
|
gap)))))
|
|
|
|
update-container
|
|
(fn [container]
|
|
(d/update-when container :objects update-vals update-shape))]
|
|
|
|
(-> file-data
|
|
(update :pages-index update-vals update-container)
|
|
(update :components update-vals update-container))))
|
|
|
|
fix-recent-colors
|
|
(fn [file-data]
|
|
(let [valid-color? (sm/validator ::ctc/recent-color)]
|
|
(d/update-when file-data :recent-colors
|
|
(fn [colors]
|
|
(filterv valid-color? colors)))))
|
|
|
|
fix-orphan-shapes
|
|
(fn [file-data]
|
|
;; Find shapes that are not listed in their parent's children list.
|
|
;; Remove them, and also their children
|
|
(letfn [(fix-container [container]
|
|
(reduce fix-shape container (ctn/shapes-seq container)))
|
|
|
|
(fix-shape
|
|
[container shape]
|
|
(if-not (or (= (:id shape) uuid/zero)
|
|
(nil? (:parent-id shape)))
|
|
(let [parent (ctst/get-shape container (:parent-id shape))
|
|
exists? (d/index-of (:shapes parent) (:id shape))]
|
|
(if (nil? exists?)
|
|
(let [ids (cfh/get-children-ids-with-self (:objects container) (:id shape))]
|
|
(update container :objects #(reduce dissoc % ids)))
|
|
container))
|
|
container))]
|
|
|
|
(-> file-data
|
|
(update :pages-index update-vals fix-container)
|
|
(update :components update-vals fix-container))))
|
|
|
|
remove-nested-roots
|
|
(fn [file-data]
|
|
;; Remove :component-root in head shapes that are nested.
|
|
(letfn [(fix-container [container]
|
|
(update container :objects update-vals (partial fix-shape container)))
|
|
|
|
(fix-shape [container shape]
|
|
(let [parent (ctst/get-shape container (:parent-id shape))]
|
|
(if (and (ctk/instance-root? shape)
|
|
(ctn/in-any-component? (:objects container) parent))
|
|
(dissoc shape :component-root)
|
|
shape)))]
|
|
|
|
(-> file-data
|
|
(update :pages-index update-vals fix-container)
|
|
(update :components update-vals fix-container))))
|
|
|
|
add-not-nested-roots
|
|
(fn [file-data]
|
|
;; Add :component-root in head shapes that are not nested.
|
|
(letfn [(fix-container [container]
|
|
(update container :objects update-vals (partial fix-shape container)))
|
|
|
|
(fix-shape [container shape]
|
|
(let [parent (ctst/get-shape container (:parent-id shape))]
|
|
(if (and (ctk/subinstance-head? shape)
|
|
(not (ctn/in-any-component? (:objects container) parent)))
|
|
(assoc shape :component-root true)
|
|
shape)))]
|
|
|
|
(-> file-data
|
|
(update :pages-index update-vals fix-container)
|
|
(update :components update-vals fix-container))))
|
|
|
|
fix-orphan-copies
|
|
(fn [file-data]
|
|
;; Detach shapes that were inside a copy (have :shape-ref) but now they aren't.
|
|
(letfn [(fix-container [container]
|
|
(update container :objects update-vals (partial fix-shape container)))
|
|
|
|
(fix-shape [container shape]
|
|
(let [parent (ctst/get-shape container (:parent-id shape))]
|
|
(if (and (ctk/in-component-copy? shape)
|
|
(not (ctk/instance-head? shape))
|
|
(not (ctk/in-component-copy? parent)))
|
|
(detach-shape container shape)
|
|
shape)))]
|
|
|
|
(-> file-data
|
|
(update :pages-index update-vals fix-container)
|
|
(update :components update-vals fix-container))))
|
|
|
|
remap-refs
|
|
(fn [file-data]
|
|
;; Remap shape-refs so that they point to the near main.
|
|
;; At the same time, if there are any dangling ref, detach the shape and its children.
|
|
(letfn [(fix-container [container]
|
|
(reduce fix-shape container (ctn/shapes-seq container)))
|
|
|
|
(fix-shape [container shape]
|
|
(if (ctk/in-component-copy? shape)
|
|
;; First look for the direct shape.
|
|
(let [root (ctn/get-component-shape (:objects container) shape)
|
|
libraries (assoc-in libraries [(:id file-data) :data] file-data)
|
|
library (get libraries (:component-file root))
|
|
component (ctkl/get-component (:data library) (:component-id root) true)
|
|
direct-shape (ctf/get-component-shape (:data library) component (:shape-ref shape))]
|
|
(if (some? direct-shape)
|
|
;; If it exists, there is nothing else to do.
|
|
container
|
|
;; If not found, find the near shape.
|
|
(let [near-shape (d/seek #(= (:shape-ref %) (:shape-ref shape))
|
|
(ctf/get-component-shapes (:data library) component))]
|
|
(if (some? near-shape)
|
|
;; If found, update the ref to point to the near shape.
|
|
(ctn/update-shape container (:id shape) #(assoc % :shape-ref (:id near-shape)))
|
|
;; If not found, it may be a fostered component. Try to locate a direct shape
|
|
;; in the head component.
|
|
(let [head (ctn/get-head-shape (:objects container) shape)
|
|
library-2 (get libraries (:component-file head))
|
|
component-2 (ctkl/get-component (:data library-2) (:component-id head) true)
|
|
direct-shape-2 (ctf/get-component-shape (:data library-2) component-2 (:shape-ref shape))]
|
|
(if (some? direct-shape-2)
|
|
;; If it exists, there is nothing else to do.
|
|
container
|
|
;; If not found, detach shape and all children (stopping if a nested instance is reached)
|
|
(let [children (ctn/get-children-in-instance (:objects container) (:id shape))]
|
|
(reduce #(ctn/update-shape %1 (:id %2) (partial detach-shape %1))
|
|
container
|
|
children))))))))
|
|
container))]
|
|
|
|
(-> file-data
|
|
(update :pages-index update-vals fix-container)
|
|
(update :components update-vals fix-container))))
|
|
|
|
fix-copies-of-detached
|
|
(fn [file-data]
|
|
;; Find any copy that is referencing a detached shape inside a component, and
|
|
;; undo the nested copy, converting it into a direct copy.
|
|
(letfn [(fix-container [container]
|
|
(update container :objects update-vals fix-shape))
|
|
|
|
(fix-shape [shape]
|
|
(cond-> shape
|
|
(@detached-ids (:shape-ref shape))
|
|
(dissoc shape
|
|
:component-id
|
|
:component-file
|
|
:component-root)))]
|
|
(-> file-data
|
|
(update :pages-index update-vals fix-container)
|
|
(update :components update-vals fix-container))))
|
|
|
|
transform-to-frames
|
|
(fn [file-data]
|
|
;; Transform component and copy heads to frames, and set the
|
|
;; frame-id of its childrens
|
|
(letfn [(fix-container [container]
|
|
(update container :objects update-vals fix-shape))
|
|
|
|
(fix-shape [shape]
|
|
(if (or (nil? (:parent-id shape)) (ctk/instance-head? shape))
|
|
(assoc shape
|
|
:type :frame ; Old groups must be converted
|
|
:fills (or (:fills shape) []) ; to frames and conform to spec
|
|
:shapes (or (:shapes shape) [])
|
|
:hide-in-viewer (or (:hide-in-viewer shape) true)
|
|
:rx (or (:rx shape) 0)
|
|
:ry (or (:ry shape) 0))
|
|
shape))]
|
|
(-> file-data
|
|
(update :pages-index update-vals fix-container)
|
|
(update :components update-vals fix-container))))
|
|
|
|
remap-frame-ids
|
|
(fn [file-data]
|
|
;; Remap the frame-ids of the primary childs of the head instances
|
|
;; to point to the head instance.
|
|
(letfn [(fix-container
|
|
[container]
|
|
(update container :objects update-vals (partial fix-shape container)))
|
|
|
|
(fix-shape
|
|
[container shape]
|
|
(let [parent (ctst/get-shape container (:parent-id shape))]
|
|
(if (ctk/instance-head? parent)
|
|
(assoc shape :frame-id (:id parent))
|
|
shape)))]
|
|
(-> file-data
|
|
(update :pages-index update-vals fix-container)
|
|
(update :components update-vals fix-container))))
|
|
|
|
fix-frame-ids
|
|
(fn [file-data]
|
|
;; Ensure that frame-id of all shapes point to the parent or to the frame-id
|
|
;; of the parent, and that the destination is indeed a frame.
|
|
(letfn [(fix-container [container]
|
|
(update container :objects #(cfh/reduce-objects % fix-shape %)))
|
|
|
|
(fix-shape [objects shape]
|
|
(let [parent (when (:parent-id shape)
|
|
(get objects (:parent-id shape)))
|
|
error? (when (some? parent)
|
|
(if (= (:type parent) :frame)
|
|
(not= (:frame-id shape) (:id parent))
|
|
(not= (:frame-id shape) (:frame-id parent))))]
|
|
(if error?
|
|
(let [nearest-frame (cfh/get-frame objects (:parent-id shape))
|
|
frame-id (or (:id nearest-frame) uuid/zero)]
|
|
(update objects (:id shape) assoc :frame-id frame-id))
|
|
objects)))]
|
|
|
|
(-> file-data
|
|
(update :pages-index update-vals fix-container)
|
|
(update :components update-vals fix-container))))
|
|
|
|
fix-component-nil-objects
|
|
(fn [file-data]
|
|
;; Ensure that objects of all components is not null
|
|
(letfn [(fix-component [component]
|
|
(if (and (contains? component :objects) (nil? (:objects component)))
|
|
(if (:deleted component)
|
|
(assoc component :objects {})
|
|
(dissoc component :objects))
|
|
component))]
|
|
(-> file-data
|
|
(update :components update-vals fix-component))))
|
|
|
|
fix-false-copies
|
|
(fn [file-data]
|
|
;; Find component heads that are not main-instance but have not :shape-ref.
|
|
(letfn [(fix-container
|
|
[container]
|
|
(update container :objects update-vals fix-shape))
|
|
|
|
(fix-shape
|
|
[shape]
|
|
(if (and (ctk/instance-head? shape)
|
|
(not (ctk/main-instance? shape))
|
|
(not (ctk/in-component-copy? shape)))
|
|
(ctk/detach-shape shape)
|
|
shape))]
|
|
(-> file-data
|
|
(update :pages-index update-vals fix-container)
|
|
(update :components update-vals fix-container))))]
|
|
|
|
(-> file-data
|
|
(fix-misc-shape-issues)
|
|
(fix-recent-colors)
|
|
(fix-orphan-shapes)
|
|
(remove-nested-roots)
|
|
(add-not-nested-roots)
|
|
(fix-orphan-copies)
|
|
(remap-refs)
|
|
(fix-copies-of-detached)
|
|
(transform-to-frames)
|
|
(remap-frame-ids)
|
|
(fix-frame-ids)
|
|
(fix-component-nil-objects)
|
|
(fix-false-copies))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; COMPONENTS MIGRATION
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defn- get-asset-groups
|
|
[assets generic-name]
|
|
(let [;; Group by first element of the path.
|
|
groups (d/group-by #(first (cfh/split-path (:path %))) assets)
|
|
|
|
;; Split large groups in chunks of max-group-size elements
|
|
groups (loop [groups (seq groups)
|
|
result {}]
|
|
(if (empty? groups)
|
|
result
|
|
(let [[group-name assets] (first groups)
|
|
group-name (if (or (nil? group-name) (str/empty? group-name))
|
|
generic-name
|
|
group-name)]
|
|
(if (<= (count assets) max-group-size)
|
|
(recur (next groups)
|
|
(assoc result group-name assets))
|
|
(let [splits (-> (partition-all max-group-size assets)
|
|
(d/enumerate))]
|
|
(recur (next groups)
|
|
(reduce (fn [result [index split]]
|
|
(let [split-name (str group-name " " (inc index))]
|
|
(assoc result split-name split)))
|
|
result
|
|
splits)))))))
|
|
|
|
;; Sort assets in each group by path
|
|
groups (update-vals groups (fn [assets]
|
|
(sort-by (fn [{:keys [path name]}]
|
|
(str/lower (cfh/merge-path-item path name)))
|
|
assets)))]
|
|
|
|
;; Sort groups by name
|
|
(into (sorted-map) groups)))
|
|
|
|
(defn- create-frame
|
|
[name position width height]
|
|
(cts/setup-shape
|
|
{:type :frame
|
|
:x (:x position)
|
|
:y (:y position)
|
|
:width (+ width (* 2 grid-gap))
|
|
:height (+ height (* 2 grid-gap))
|
|
:name name
|
|
:frame-id uuid/zero
|
|
:parent-id uuid/zero}))
|
|
|
|
(defn- migrate-components
|
|
"If there is any component in the file library, add a new 'Library
|
|
backup', generate main instances for all components there and remove
|
|
shapes from library components. Mark the file with the :components-v2 option."
|
|
[file-data libraries]
|
|
(sse/tap {:type :migration-progress
|
|
:section :components})
|
|
(let [file-data (prepare-file-data file-data libraries)
|
|
components (ctkl/components-seq file-data)]
|
|
(if (empty? components)
|
|
(assoc-in file-data [:options :components-v2] true)
|
|
(let [[file-data page-id start-pos]
|
|
(ctf/get-or-add-library-page file-data frame-gap)
|
|
|
|
migrate-component-shape
|
|
(fn [shape delta component-file component-id frame-id]
|
|
(cond-> shape
|
|
(nil? (:parent-id shape))
|
|
(assoc :parent-id frame-id
|
|
:main-instance true
|
|
:component-root true
|
|
:component-file component-file
|
|
:component-id component-id)
|
|
|
|
(nil? (:frame-id shape))
|
|
(assoc :frame-id frame-id)
|
|
|
|
:always
|
|
(gsh/move delta)))
|
|
|
|
add-main-instance
|
|
(fn [file-data component frame-id position]
|
|
(let [shapes (cfh/get-children-with-self (:objects component)
|
|
(:id component))
|
|
|
|
root-shape (first shapes)
|
|
orig-pos (gpt/point (:x root-shape) (:y root-shape))
|
|
delta (gpt/subtract position orig-pos)
|
|
|
|
xf-shape (map #(migrate-component-shape %
|
|
delta
|
|
(:id file-data)
|
|
(:id component)
|
|
frame-id))
|
|
new-shapes
|
|
(into [] xf-shape shapes)
|
|
|
|
find-frame-id ; if its parent is a frame, the frame-id should be the parent-id
|
|
(fn [page shape]
|
|
(let [parent (ctst/get-shape page (:parent-id shape))]
|
|
(if (= :frame (:type parent))
|
|
(:id parent)
|
|
(:frame-id parent))))
|
|
|
|
add-shapes
|
|
(fn [page]
|
|
(reduce (fn [page shape]
|
|
(ctst/add-shape (:id shape)
|
|
shape
|
|
page
|
|
(find-frame-id page shape)
|
|
(:parent-id shape)
|
|
nil ; <- As shapes are ordered, we can safely add each
|
|
true)) ; one at the end of the parent's children list.
|
|
page
|
|
new-shapes))
|
|
|
|
update-component
|
|
(fn [component]
|
|
(-> component
|
|
(assoc :main-instance-id (:id root-shape)
|
|
:main-instance-page page-id)
|
|
(dissoc :objects)))]
|
|
|
|
(-> file-data
|
|
(ctpl/update-page page-id add-shapes)
|
|
(ctkl/update-component (:id component) update-component))))
|
|
|
|
add-instance-grid
|
|
(fn [fdata frame-id grid assets]
|
|
(reduce (fn [result [component position]]
|
|
(sse/tap {:type :migration-progress
|
|
:section :components
|
|
:name (:name component)})
|
|
(add-main-instance result component frame-id (gpt/add position
|
|
(gpt/point grid-gap grid-gap))))
|
|
fdata
|
|
(d/zip assets grid)))
|
|
|
|
add-instance-grids
|
|
(fn [fdata]
|
|
(let [components (ctkl/components-seq fdata)
|
|
groups (get-asset-groups components "Components")]
|
|
(loop [groups (seq groups)
|
|
fdata fdata
|
|
position start-pos]
|
|
(if (empty? groups)
|
|
fdata
|
|
(let [[group-name assets] (first groups)
|
|
grid (ctst/generate-shape-grid
|
|
(map (partial ctf/get-component-root fdata) assets)
|
|
position
|
|
grid-gap)
|
|
{:keys [width height]} (meta grid)
|
|
frame (create-frame group-name position width height)
|
|
fdata (ctpl/update-page fdata
|
|
page-id
|
|
#(ctst/add-shape (:id frame)
|
|
frame
|
|
%
|
|
(:id frame)
|
|
(:id frame)
|
|
nil
|
|
true))]
|
|
(recur (next groups)
|
|
(add-instance-grid fdata (:id frame) grid assets)
|
|
(gpt/add position (gpt/point 0 (+ height (* 2 grid-gap) frame-gap)))))))))]
|
|
|
|
(let [total (count components)]
|
|
(some-> *stats* (swap! update :processed/components (fnil + 0) total))
|
|
(some-> *team-stats* (swap! update :processed/components (fnil + 0) total))
|
|
(some-> *file-stats* (swap! assoc :processed/components total)))
|
|
|
|
(add-instance-grids file-data)))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; GRAPHICS MIGRATION
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defn- create-shapes-for-bitmap
|
|
"Convert a media object that contains a bitmap image into shapes,
|
|
one shape of type :image and one group that contains it."
|
|
[{:keys [name width height id mtype]} frame-id position]
|
|
(let [frame-shape (cts/setup-shape
|
|
{:type :frame
|
|
:x (:x position)
|
|
:y (:y position)
|
|
:width width
|
|
:height height
|
|
:name name
|
|
:frame-id frame-id
|
|
:parent-id frame-id})
|
|
|
|
img-shape (cts/setup-shape
|
|
{:type :image
|
|
:x (:x position)
|
|
:y (:y position)
|
|
:width width
|
|
:height height
|
|
:metadata {:id id
|
|
:width width
|
|
:height height
|
|
:mtype mtype}
|
|
:name name
|
|
:frame-id (:id frame-shape)
|
|
:parent-id (:id frame-shape)})]
|
|
[frame-shape [img-shape]]))
|
|
|
|
(defn- parse-datauri
|
|
[data]
|
|
(let [[mtype b64-data] (str/split data ";base64," 2)
|
|
mtype (subs mtype (inc (str/index-of mtype ":")))
|
|
data (-> b64-data bc/str->bytes bc/b64->bytes)]
|
|
[mtype data]))
|
|
|
|
(defn- extract-name
|
|
[href]
|
|
(let [query-idx (d/nilv (str/last-index-of href "?") 0)
|
|
href (if (> query-idx 0) (subs href 0 query-idx) href)
|
|
filename (->> (str/split href "/") (last))
|
|
ext-idx (str/last-index-of filename ".")]
|
|
(if (> ext-idx 0) (subs filename 0 ext-idx) filename)))
|
|
|
|
(defn- collect-and-persist-images
|
|
[svg-data file-id media-id]
|
|
(letfn [(process-image [{:keys [href] :as item}]
|
|
(try
|
|
(let [item (if (str/starts-with? href "data:")
|
|
(let [[mtype data] (parse-datauri href)
|
|
size (alength data)
|
|
path (tmp/tempfile :prefix "penpot.media.download.")
|
|
written (io/write-to-file! data path :size size)]
|
|
|
|
(when (not= written size)
|
|
(ex/raise :type :internal
|
|
:code :mismatch-write-size
|
|
:hint "unexpected state: unable to write to file"))
|
|
|
|
(-> item
|
|
(assoc :size size)
|
|
(assoc :path path)
|
|
(assoc :filename "tempfile")
|
|
(assoc :mtype mtype)))
|
|
|
|
(let [result (cmd.media/download-image *system* href)]
|
|
(-> (merge item result)
|
|
(assoc :name (extract-name href)))))]
|
|
|
|
;; The media processing adds the data to the
|
|
;; input map and returns it.
|
|
(media/run {:cmd :info :input item}))
|
|
(catch Throwable _
|
|
(let [team-id *team-id*]
|
|
(l/wrn :hint "unable to process embedded images on svg file"
|
|
:team-id (str team-id)
|
|
:file-id (str file-id)
|
|
:media-id (str media-id)))
|
|
nil)))
|
|
|
|
(persist-image [acc {:keys [path size width height mtype href] :as item}]
|
|
(let [storage (::sto/storage *system*)
|
|
conn (::db/conn *system*)
|
|
hash (sto/calculate-hash path)
|
|
content (-> (sto/content path size)
|
|
(sto/wrap-with-hash hash))
|
|
params {::sto/content content
|
|
::sto/deduplicate? true
|
|
::sto/touched-at (:ts item)
|
|
:content-type mtype
|
|
:bucket "file-media-object"}
|
|
image (sto/put-object! storage params)
|
|
fmo-id (uuid/next)]
|
|
|
|
(db/exec-one! conn
|
|
[cmd.media/sql:create-file-media-object
|
|
fmo-id
|
|
file-id true (:name item "image")
|
|
(:id image)
|
|
nil
|
|
width
|
|
height
|
|
mtype])
|
|
|
|
(assoc acc href {:id fmo-id
|
|
:mtype mtype
|
|
:width width
|
|
:height height})))]
|
|
|
|
(let [images (->> (csvg/collect-images svg-data)
|
|
(transduce (keep process-image)
|
|
(completing persist-image) {}))]
|
|
(assoc svg-data :image-data images))))
|
|
|
|
(defn- resolve-sobject-id
|
|
[id]
|
|
(let [fmobject (db/get *system* :file-media-object {:id id}
|
|
{::sql/columns [:media-id]})]
|
|
(:media-id fmobject)))
|
|
|
|
(defn- get-sobject-content
|
|
[id]
|
|
(let [storage (::sto/storage *system*)
|
|
sobject (sto/get-object storage id)]
|
|
(with-open [stream (sto/get-object-data storage sobject)]
|
|
(slurp stream))))
|
|
|
|
(defn- create-shapes-for-svg
|
|
[{:keys [id] :as mobj} file-id objects frame-id position]
|
|
(let [get-svg (fn [sid]
|
|
(let [svg-text (get-sobject-content sid)
|
|
svg-text (svgo/optimize *system* svg-text)]
|
|
(-> (csvg/parse svg-text)
|
|
(assoc :name (:name mobj)))))
|
|
|
|
sid (resolve-sobject-id id)
|
|
svg-data (if (cache/cache? *cache*)
|
|
(cache/get *cache* sid (px/wrap-bindings get-svg))
|
|
(get-svg sid))
|
|
|
|
svg-data (collect-and-persist-images svg-data file-id id)]
|
|
|
|
(sbuilder/create-svg-shapes svg-data position objects frame-id frame-id #{} false)))
|
|
|
|
(defn- process-media-object
|
|
[fdata page-id frame-id mobj position]
|
|
(let [page (ctpl/get-page fdata page-id)
|
|
file-id (get fdata :id)
|
|
|
|
[shape children]
|
|
(if (= (:mtype mobj) "image/svg+xml")
|
|
(create-shapes-for-svg mobj file-id (:objects page) frame-id position)
|
|
(create-shapes-for-bitmap mobj frame-id position))
|
|
|
|
shape (assoc shape :name (-> "Graphics"
|
|
(cfh/merge-path-item (:path mobj))
|
|
(cfh/merge-path-item (:name mobj))))
|
|
|
|
changes
|
|
(-> (fcb/empty-changes nil)
|
|
(fcb/set-save-undo? false)
|
|
(fcb/with-page page)
|
|
(fcb/with-objects (:objects page))
|
|
(fcb/with-library-data fdata)
|
|
(fcb/delete-media (:id mobj))
|
|
(fcb/add-objects (cons shape children)))
|
|
|
|
;; NOTE: this is a workaround for `generate-add-component`, it
|
|
;; is needed because that function always starts from empty
|
|
;; changes; so in this case we need manually add all shapes to
|
|
;; the page and then use that page for the
|
|
;; `generate-add-component` function
|
|
page
|
|
(reduce (fn [page shape]
|
|
(ctst/add-shape (:id shape)
|
|
shape
|
|
page
|
|
frame-id
|
|
frame-id
|
|
nil
|
|
true))
|
|
page
|
|
(cons shape children))
|
|
|
|
[_ _ changes2]
|
|
(cflh/generate-add-component nil
|
|
[shape]
|
|
(:objects page)
|
|
(:id page)
|
|
file-id
|
|
true
|
|
nil
|
|
cfsh/prepare-create-artboard-from-selection)
|
|
changes (fcb/concat-changes changes changes2)]
|
|
|
|
(:redo-changes changes)))
|
|
|
|
(defn- create-media-grid
|
|
[fdata page-id frame-id grid media-group]
|
|
(letfn [(process [fdata mobj position]
|
|
(let [position (gpt/add position (gpt/point grid-gap grid-gap))
|
|
tp (dt/tpoint)
|
|
err (volatile! false)]
|
|
(try
|
|
(let [changes (process-media-object fdata page-id frame-id mobj position)]
|
|
(cp/process-changes fdata changes false))
|
|
|
|
(catch Throwable cause
|
|
(vreset! err true)
|
|
(let [cause (pu/unwrap-exception cause)
|
|
edata (ex-data cause)
|
|
team-id *team-id*]
|
|
(cond
|
|
(instance? org.xml.sax.SAXParseException cause)
|
|
(l/inf :hint "skip processing media object: invalid svg found"
|
|
:team-id (str team-id)
|
|
:file-id (str (:id fdata))
|
|
:id (str (:id mobj)))
|
|
|
|
(= (:type edata) :not-found)
|
|
(l/inf :hint "skip processing media object: underlying object does not exist"
|
|
:team-id (str team-id)
|
|
:file-id (str (:id fdata))
|
|
:id (str (:id mobj)))
|
|
|
|
:else
|
|
(let [skip? *skip-on-graphic-error*]
|
|
(l/wrn :hint "unable to process file media object"
|
|
:skiped skip?
|
|
:team-id (str team-id)
|
|
:file-id (str (:id fdata))
|
|
:id (str (:id mobj))
|
|
:cause cause)
|
|
(when-not skip?
|
|
(throw cause))))
|
|
nil))
|
|
(finally
|
|
(let [elapsed (tp)]
|
|
(l/trc :hint "graphic processed"
|
|
:file-id (str (:id fdata))
|
|
:media-id (str (:id mobj))
|
|
:error @err
|
|
:elapsed (dt/format-duration elapsed)))))))]
|
|
|
|
(->> (d/zip media-group grid)
|
|
(reduce (fn [fdata [mobj position]]
|
|
(sse/tap {:type :migration-progress
|
|
:section :graphics
|
|
:name (:name mobj)})
|
|
(or (process fdata mobj position) fdata))
|
|
(assoc-in fdata [:options :components-v2] true)))))
|
|
|
|
(defn- migrate-graphics
|
|
[fdata]
|
|
(sse/tap {:type :migration-progress
|
|
:section :graphics})
|
|
(if (empty? (:media fdata))
|
|
fdata
|
|
(let [[fdata page-id start-pos]
|
|
(ctf/get-or-add-library-page fdata frame-gap)
|
|
|
|
media (->> (vals (:media fdata))
|
|
(map (fn [{:keys [width height] :as media}]
|
|
(let [points (-> (grc/make-rect 0 0 width height)
|
|
(grc/rect->points))]
|
|
(assoc media :points points)))))
|
|
|
|
groups (get-asset-groups media "Graphics")]
|
|
|
|
(let [total (count media)]
|
|
(some-> *stats* (swap! update :processed/graphics (fnil + 0) total))
|
|
(some-> *team-stats* (swap! update :processed/graphics (fnil + 0) total))
|
|
(some-> *file-stats* (swap! assoc :processed/graphics total)))
|
|
|
|
(loop [groups (seq groups)
|
|
fdata fdata
|
|
position start-pos]
|
|
(if (empty? groups)
|
|
fdata
|
|
(let [[group-name assets] (first groups)
|
|
grid (ctst/generate-shape-grid assets position grid-gap)
|
|
{:keys [width height]} (meta grid)
|
|
frame (create-frame group-name position width height)
|
|
fdata (ctpl/update-page fdata
|
|
page-id
|
|
#(ctst/add-shape (:id frame)
|
|
frame
|
|
%
|
|
(:id frame)
|
|
(:id frame)
|
|
nil
|
|
true))]
|
|
(recur (next groups)
|
|
(create-media-grid fdata page-id (:id frame) grid assets)
|
|
(gpt/add position (gpt/point 0 (+ height (* 2 grid-gap) frame-gap))))))))))
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; PRIVATE HELPERS
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defn- migrate-fdata
|
|
[fdata libs]
|
|
(let [migrated? (dm/get-in fdata [:options :components-v2])]
|
|
(if migrated?
|
|
fdata
|
|
(let [fdata (migrate-components fdata libs)
|
|
fdata (migrate-graphics fdata)]
|
|
(update fdata :options assoc :components-v2 true)))))
|
|
|
|
(defn- get-file
|
|
[system id]
|
|
(binding [pmap/*load-fn* (partial fdata/load-pointer system id)]
|
|
(-> (db/get system :file {:id id}
|
|
{::db/remove-deleted false
|
|
::db/check-deleted false})
|
|
(decode-row)
|
|
(update :data assoc :id id)
|
|
(update :data fdata/process-pointers deref)
|
|
(update :data fdata/process-objects (partial into {}))
|
|
(fmg/migrate-file))))
|
|
|
|
(defn- get-team
|
|
[system team-id]
|
|
(-> (db/get system :team {:id team-id}
|
|
{::db/remove-deleted false
|
|
::db/check-deleted false})
|
|
(decode-row)))
|
|
|
|
(defn- validate-file!
|
|
[file libs]
|
|
(cfv/validate-file! file libs)
|
|
(cfv/validate-file-schema! file))
|
|
|
|
(defn- process-file
|
|
[{:keys [::db/conn] :as system} id & {:keys [validate?]}]
|
|
(let [file (get-file system id)
|
|
|
|
libs (->> (files/get-file-libraries conn id)
|
|
(into [file] (comp (map :id)
|
|
(map (partial get-file system))))
|
|
(d/index-by :id))
|
|
|
|
file (-> file
|
|
(update :data migrate-fdata libs)
|
|
(update :features conj "components/v2"))
|
|
|
|
_ (when validate?
|
|
(validate-file! file libs))
|
|
|
|
file (if (contains? (:features file) "fdata/objects-map")
|
|
(fdata/enable-objects-map file)
|
|
file)
|
|
|
|
file (if (contains? (:features file) "fdata/pointer-map")
|
|
(binding [pmap/*tracked* (pmap/create-tracked)]
|
|
(let [file (fdata/enable-pointer-map file)]
|
|
(fdata/persist-pointers! system id)
|
|
file))
|
|
file)]
|
|
|
|
(db/update! conn :file
|
|
{:data (blob/encode (:data file))
|
|
:features (db/create-array conn "text" (:features file))
|
|
:revn (:revn file)}
|
|
{:id (:id file)})
|
|
|
|
(dissoc file :data)))
|
|
|
|
(def ^:private sql:get-and-lock-team-files
|
|
"SELECT f.id
|
|
FROM file AS f
|
|
JOIN project AS p ON (p.id = f.project_id)
|
|
WHERE p.team_id = ?
|
|
AND p.deleted_at IS NULL
|
|
AND f.deleted_at IS NULL
|
|
FOR UPDATE")
|
|
|
|
(defn- get-and-lock-files
|
|
[conn team-id]
|
|
(->> (db/cursor conn [sql:get-and-lock-team-files team-id])
|
|
(map :id)))
|
|
|
|
(defn- update-team-features!
|
|
[conn team-id features]
|
|
(let [features (db/create-array conn "text" features)]
|
|
(db/update! conn :team
|
|
{:features features}
|
|
{:id team-id})))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; PUBLIC API
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defn migrate-file!
|
|
[system file-id & {:keys [validate? skip-on-graphic-error?]}]
|
|
(let [tpoint (dt/tpoint)]
|
|
(binding [*file-stats* (atom {})
|
|
*skip-on-graphic-error* skip-on-graphic-error?]
|
|
(try
|
|
(l/dbg :hint "migrate:file:start"
|
|
:file-id (str file-id)
|
|
:validate validate?
|
|
:skip-on-graphics-error skip-on-graphic-error?)
|
|
|
|
(let [system (update system ::sto/storage media/configure-assets-storage)]
|
|
(db/tx-run! system
|
|
(fn [system]
|
|
(try
|
|
(binding [*system* system]
|
|
(fsnap/take-file-snapshot! system {:file-id file-id :label "migration/components-v2"})
|
|
(process-file system file-id :validate? validate?))
|
|
|
|
(catch Throwable cause
|
|
(let [team-id *team-id*]
|
|
(l/wrn :hint "error on processing file"
|
|
:team-id (str team-id)
|
|
:file-id (str file-id))
|
|
(throw cause)))))))
|
|
|
|
(finally
|
|
(let [elapsed (tpoint)
|
|
components (get @*file-stats* :processed/components 0)
|
|
graphics (get @*file-stats* :processed/graphics 0)]
|
|
|
|
(l/dbg :hint "migrate:file:end"
|
|
:file-id (str file-id)
|
|
:graphics graphics
|
|
:components components
|
|
:validate validate?
|
|
:elapsed (dt/format-duration elapsed))
|
|
|
|
(some-> *stats* (swap! update :processed/files (fnil inc 0)))
|
|
(some-> *team-stats* (swap! update :processed/files (fnil inc 0)))))))))
|
|
|
|
(defn migrate-team!
|
|
[system team-id & {:keys [validate? skip-on-graphic-error?]}]
|
|
|
|
(l/dbg :hint "migrate:team:start"
|
|
:team-id (dm/str team-id))
|
|
|
|
(let [tpoint (dt/tpoint)
|
|
err (volatile! false)
|
|
|
|
migrate-file
|
|
(fn [system file-id]
|
|
(migrate-file! system file-id
|
|
:validate? validate?
|
|
:skip-on-graphics-error? skip-on-graphic-error?))
|
|
migrate-team
|
|
(fn [{:keys [::db/conn] :as system} {:keys [id features] :as team}]
|
|
(let [features (-> features
|
|
(disj "ephimeral/v2-migration")
|
|
(conj "components/v2")
|
|
(conj "layout/grid")
|
|
(conj "styles/v2"))]
|
|
|
|
(run! (partial migrate-file system)
|
|
(get-and-lock-files conn id))
|
|
|
|
(update-team-features! conn id features)))]
|
|
|
|
(binding [*team-stats* (atom {})
|
|
*team-id* team-id]
|
|
(try
|
|
(db/tx-run! system (fn [system]
|
|
(db/exec-one! system ["SET idle_in_transaction_session_timeout = 0"])
|
|
(let [team (get-team system team-id)]
|
|
(if (contains? (:features team) "components/v2")
|
|
(l/inf :hint "team already migrated")
|
|
(migrate-team system team)))))
|
|
(catch Throwable cause
|
|
(vreset! err true)
|
|
(throw cause))
|
|
|
|
(finally
|
|
(let [elapsed (tpoint)
|
|
components (get @*team-stats* :processed/components 0)
|
|
graphics (get @*team-stats* :processed/graphics 0)
|
|
files (get @*team-stats* :processed/files 0)]
|
|
|
|
(some-> *stats* (swap! update :processed/teams (fnil inc 0)))
|
|
|
|
(if (cache/cache? *cache*)
|
|
(let [cache-stats (cache/stats *cache*)]
|
|
(l/dbg :hint "migrate:team:end"
|
|
:team-id (dm/str team-id)
|
|
:files files
|
|
:components components
|
|
:graphics graphics
|
|
:crt (mth/to-fixed (:hit-rate cache-stats) 2)
|
|
:crq (str (:req-count cache-stats))
|
|
:error @err
|
|
:elapsed (dt/format-duration elapsed)))
|
|
|
|
(l/dbg :hint "migrate:team:end"
|
|
:team-id (dm/str team-id)
|
|
:files files
|
|
:components components
|
|
:graphics graphics
|
|
:elapsed (dt/format-duration elapsed)))))))))
|