meissa/cryogen-core
6
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

fixed remove path for paths deeper than one eleme

Browse source
This commit is contained in:
jem 2020-01-30 11:46:20 +01:00
parent e7c853cd0f
commit 4d638f84d9
1 changed files with 112 additions and 107 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

215
src/cryogen_core/classpath_able_io.clj
View file

@ -86,6 +86,7 @@
path path
(Paths/get (user-dir) (into-array String path-elements))))) (Paths/get (user-dir) (into-array String path-elements)))))
; TODO replace this fn ?
(defn path (defn path
"Creates path from given parts, ignore empty elements" "Creates path from given parts, ignore empty elements"
[& path-parts] [& path-parts]
@ -165,121 +166,125 @@
(when (some? resource) (when (some? resource)
(:java-path resource)))) (:java-path resource))))
(defn remove-first-path-item (defn filter-and-remove-for-dir
[seq-of-paths] [path-to-filter-for
(let [fun (fn [str-arg] (st/join "/" (rest (st/split str-arg #"/"))))] elements-list]
(map fun seq-of-paths))) (let [norm-path-to-filter-for (str path-to-filter-for "/")]
(map
#(subs % (count norm-path-to-filter-for))
(filter
(fn [element] (and (st/starts-with? element norm-path-to-filter-for)
(not (= element norm-path-to-filter-for))))
elements-list))))
(s/defn (s/defn
list-entries-for-dir ;:- [VirtualPath] list-entries-for-dir ;:- [VirtualPath]
[resource :- Resource] [resource :- Resource]
(if (= :java-classpath-jar (:source-type resource)) (if (= :java-classpath-jar (:source-type resource))
(remove-first-path-item (filter (filter-and-remove-for-dir
(fn [je] (and (st/starts-with? je (:virtual-path resource)) (:virtual-path resource)
(not (= je (str (:virtual-path resource) "/"))))) (map #(.getName ^JarEntry %)
(map #(.getName ^JarEntry %) (enumeration-seq
(enumeration-seq (.entries
(.entries (JarFile.
(JarFile. (.toFile
(.toFile (Paths/get
(Paths/get (URI.
(URI. (.getSchemeSpecificPart
(.getSchemeSpecificPart (filesystem-uri (:java-uri resource)))))))))))
(filesystem-uri (:java-uri resource)))))))))))) (.list (.toFile (:java-path resource)))))
; Bsp-Code: https://github.com/clojure/java.classpath/blob/c10fc96a8ff98db4eb925a13ef0f5135ad8dacc6/src/main/clojure/clojure/java/classpath.clj#L50
(.list (.toFile (:java-path resource)))))
(defn get-resources-recursive ;:- [Resource] (defn get-resources-recursive ;:- [Resource]
[fs-prefix ;:- Prefix [fs-prefix ;:- Prefix
base-path ;:- VirtualPath base-path ;:- VirtualPath
paths ;:- [VirtualPath] paths ;:- [VirtualPath]
& {:keys [from-cp from-fs] & {:keys [from-cp from-fs]
:or {from-cp true :or {from-cp true
from-fs true}}] from-fs true}}]
(loop [paths paths (loop [paths paths
result []] result []]
(if (not (empty? paths)) (if (not (empty? paths))
(do (do
(let [path-to-work-with (first paths) (let [path-to-work-with (first paths)
resource-to-work-with (resource-from-cp-or-fs resource-to-work-with (resource-from-cp-or-fs
fs-prefix fs-prefix
base-path base-path
path-to-work-with path-to-work-with
:from-cp from-cp :from-cp from-cp
:from-fs from-fs) :from-fs from-fs)
result (into result result (into result
[resource-to-work-with])] [resource-to-work-with])]
; (println path-to-work-with) ; (println path-to-work-with)
; (println (:java-path resource-to-work-with)) ; (println (:java-path resource-to-work-with))
(cond (cond
(nil? resource-to-work-with) [] (nil? resource-to-work-with) []
(is-file? resource-to-work-with) (is-file? resource-to-work-with)
(recur (drop 1 paths) result) (recur (drop 1 paths) result)
:else :else
(recur (into (drop 1 paths) (recur (into (drop 1 paths)
(map #(str path-to-work-with "/" %) (map #(str path-to-work-with "/" %)
(list-entries-for-dir resource-to-work-with))) (list-entries-for-dir resource-to-work-with)))
result)))) result))))
result))) result)))
(defn get-resource-paths-recursive ;:- [VirtualPath] (defn get-resource-paths-recursive ;:- [VirtualPath]
[fs-prefix ;:- Prefix [fs-prefix ;:- Prefix
base-path ;:- VirtualPath base-path ;:- VirtualPath
paths ;:- [VirtualPath] paths ;:- [VirtualPath]
& {:keys [from-cp from-fs] & {:keys [from-cp from-fs]
:or {from-cp true :or {from-cp true
from-fs true}}] from-fs true}}]
(map #(:virtual-path %) (map #(:virtual-path %)
(get-resources-recursive (get-resources-recursive
fs-prefix base-path paths fs-prefix base-path paths
:from-cp from-cp :from-cp from-cp
:from-fs from-fs))) :from-fs from-fs)))
; TODO: Add files to keep ; TODO: Add files to keep
(s/defn delete-resource-recursive! (s/defn delete-resource-recursive!
[virtual-path :- s/Str] [virtual-path :- s/Str]
(let [resource-paths (let [resource-paths
(reverse (get-resource-paths-recursive (reverse (get-resource-paths-recursive
(str (user-dir) "/") (str (user-dir) "/")
virtual-path virtual-path
[""] [""]
:from-cp false))] :from-cp false))]
(doseq [resource-path resource-paths] (doseq [resource-path resource-paths]
(Files/delete (absolut-path virtual-path resource-path)) (Files/delete (absolut-path virtual-path resource-path))
))) )))
; TODO: add ignore patterns filtering ; TODO: add ignore patterns filtering
(defn copy-resources! (defn copy-resources!
[fs-prefix ;:- Prefix [fs-prefix ;:- Prefix
base-path ;:- VirtualPath base-path ;:- VirtualPath
source-paths ;:- [VirtualPath] source-paths ;:- [VirtualPath]
target-path ;:- VirtualPath target-path ;:- VirtualPath
ignore-patterns ;:- s/Str ignore-patterns ;:- s/Str
] ]
(let [resource-paths (let [resource-paths
(get-resource-paths-recursive fs-prefix base-path source-paths)] (get-resource-paths-recursive fs-prefix base-path source-paths)]
(if (empty? resource-paths) (if (empty? resource-paths)
(throw (IllegalArgumentException. (str "resource " resource-paths ", " (throw (IllegalArgumentException. (str "resource " resource-paths ", "
source-paths " not found"))) source-paths " not found")))
(doseq [resource-path resource-paths] (doseq [resource-path resource-paths]
(let [target-file (absolut-path target-path resource-path) (let [target-file (absolut-path target-path resource-path)
source-file (path-from-cp-or-fs source-file (path-from-cp-or-fs
fs-prefix fs-prefix
base-path base-path
resource-path)] resource-path)]
(when (Files/isDirectory source-file no-link-option) (when (Files/isDirectory source-file no-link-option)
(Files/createDirectories target-file (into-array FileAttribute []))) (Files/createDirectories target-file (into-array FileAttribute [])))
(when (Files/isRegularFile source-file no-link-option) (when (Files/isRegularFile source-file no-link-option)
(Files/copy source-file target-file (into-array StandardCopyOption [StandardCopyOption/COPY_ATTRIBUTES StandardCopyOption/REPLACE_EXISTING])) (Files/copy source-file target-file (into-array StandardCopyOption [StandardCopyOption/COPY_ATTRIBUTES StandardCopyOption/REPLACE_EXISTING]))
)))))) ))))))
(defn distinct-resources-by-path (defn distinct-resources-by-path
[resources] [resources]
(loop [paths (set (map :virtual-path resources)) (loop [paths (set (map :virtual-path resources))
resources resources resources resources
acc []] acc []]
(cond (empty? resources) acc (cond (empty? resources) acc
(contains? paths (:virtual-path (first resources))) (recur (disj paths (:virtual-path (first resources))) (contains? paths (:virtual-path (first resources))) (recur (disj paths (:virtual-path (first resources)))
(rest resources) (rest resources)
(conj acc (first resources))) (conj acc (first resources)))
:else (recur paths (rest resources) acc)))) :else (recur paths (rest resources) acc))))