From 39e3d57ec9e990c33d39c79cda8fa03720737019 Mon Sep 17 00:00:00 2001 From: Marshall Bockrath-Vandegrift Date: Fri, 4 Oct 2013 17:14:39 -0400 Subject: [PATCH] Implement `:uberjar-merge-with` requested in issue #973. --- leiningen-core/src/leiningen/core/project.clj | 4 + project.clj | 1 + sample.project.clj | 8 + src/leiningen/uberjar.clj | 139 ++++++++++++------ test/leiningen/test/helper.clj | 2 + test/leiningen/test/uberjar.clj | 17 +++ test_projects/uberjar-merging/project.clj | 14 ++ .../resources/data_readers.clj | 3 + 8 files changed, 142 insertions(+), 46 deletions(-) create mode 100644 test_projects/uberjar-merging/project.clj create mode 100644 test_projects/uberjar-merging/resources/data_readers.clj diff --git a/leiningen-core/src/leiningen/core/project.clj b/leiningen-core/src/leiningen/core/project.clj index ce89bbac..7bbca626 100755 --- a/leiningen-core/src/leiningen/core/project.clj +++ b/leiningen-core/src/leiningen/core/project.clj @@ -170,6 +170,10 @@ :certificates ["clojars.pem"] :offline? (not (nil? (System/getenv "LEIN_OFFLINE"))) :uberjar-exclusions [#"(?i)^META-INF/[^/]*\.(SF|RSA|DSA)$"] + :uberjar-merge-with {"META-INF/plexus/components.xml" + 'leiningen.uberjar/components-merger, + "data_readers.clj" + 'leiningen.uberjar/clj-map-merger} :global-vars {}}) (defn- dep-key diff --git a/project.clj b/project.clj index 9eddfcd4..a5b94a4c 100644 --- a/project.clj +++ b/project.clj @@ -8,6 +8,7 @@ :url "http://www.eclipse.org/legal/epl-v10.html"} :dependencies [[leiningen-core "2.3.3-SNAPSHOT"] [org.clojure/data.xml "0.0.3"] + [commons-io "2.4"] [bultitude "0.2.2"] [stencil "0.3.2"] [org.apache.maven.indexer/indexer-core "4.1.3" diff --git a/sample.project.clj b/sample.project.clj index 7e35a65a..ce6fef67 100644 --- a/sample.project.clj +++ b/sample.project.clj @@ -332,6 +332,14 @@ :jar-exclusions [#"(?:^|/).svn/"] ;; Same thing, but for uberjars. :uberjar-exclusions [#"META-INF/DUMMY.SF"] + ;; Files to merge programmatically in uberjars when multiple same-named files + ;; exist across project and dependencies. Should be a map of filename strings + ;; or regular expressions to a sequence of three functions: + ;; 1. Takes an input stream; returns a parsed datum. + ;; 2. Takes a new datum and the current result datum; returns a merged datum. + ;; 3. Takes an output stream and a datum; writes the datum to the stream. + ;; Resolved in reverse dependency order, starting with project. + :uberjar-merge-with {#"\.properties$" [slurp str spit]} ;; Add arbitrary jar entries. Supports :path, :paths, :bytes, and :fn types. :filespecs [{:type :path :path "config/base.clj"} ;; Directory paths are included recursively. diff --git a/src/leiningen/uberjar.clj b/src/leiningen/uberjar.clj index 9d9c8909..4012f8ed 100644 --- a/src/leiningen/uberjar.clj +++ b/src/leiningen/uberjar.clj @@ -6,65 +6,112 @@ [leiningen.core.classpath :as classpath] [leiningen.core.project :as project] [leiningen.core.main :as main] + [leiningen.core.utils :as utils] [leiningen.jar :as jar]) - (:import (java.util.zip ZipFile ZipOutputStream ZipEntry) - (java.io File FileOutputStream PrintWriter))) + (:import (java.io File FileOutputStream PrintWriter) + (java.util.regex Pattern) + (java.util.zip ZipFile ZipOutputStream ZipEntry) + (org.apache.commons.io.output CloseShieldOutputStream))) -(defn read-components [zipfile] - (if-let [entry (.getEntry zipfile "META-INF/plexus/components.xml")] - (->> (zip/xml-zip (xml/parse (.getInputStream zipfile entry))) - zip/children - (filter #(= (:tag %) :components)) - first - :content))) +(defn- components-read [ins] + (->> ins xml/parse zip/xml-zip zip/children + (filter #(= (:tag %) :components)) + first :content)) -;; We have to keep this separate from skip-set for performance reasons. -(defn- make-skip-pred [project] - (fn [filename] - (some #(re-find % filename) (:uberjar-exclusions project)))) +(defn- components-write [out components] + (binding [*out* (PrintWriter. out)] + (xml/emit {:tag :component-set + :content + [{:tag :components + :content components}]}) + (.flush *out*))) + +(def components-merger + "Project `:uberjar-merge-with` merger for components.xml files." + [components-read into components-write]) + +(def clj-map-merger + "Project `:uberjar-merge-with` for files containing a single map + read with `clojure.core/read`, such as data_readers.clj." + [(comp read-string slurp) merge #(spit %1 (pr-str %2))]) + +(defn- merger-match? [[pattern] filename] + (boolean + (condp instance? pattern + String (= pattern filename) + Pattern (re-find pattern filename)))) + +(def ^:private skip-merger + [(constantly ::skip) + (constantly nil)]) + +(def ^:private default-merger + [(fn [in out file prev] + (when-not prev + (.setCompressedSize file -1) + (.putNextEntry out file) + (io/copy (.getInputStream in file) out) + (.closeEntry out)) + ::skip) + (constantly nil)]) + +(defn- make-merger [fns] + {:pre [(sequential? fns) (= 3 (count fns)) (every? ifn? fns)]} + (let [[read-fn merge-fn write-fn] fns] + [(fn [in out file prev] + (with-open [ins (.getInputStream in file)] + (let [new (read-fn ins)] + (if-not prev + new + (merge-fn new prev))))) + (fn [out filename result] + (.putNextEntry out (ZipEntry. filename)) + (write-fn (CloseShieldOutputStream. out) result) + (.closeEntry out))])) + +(defn- make-mergers [project] + (into (utils/map-vals + (:uberjar-merge-with project) + (comp make-merger eval)) + (map #(-> [% skip-merger]) + (:uberjar-exclusions project)))) + +(defn- select-merger [mergers filename] + (or (->> mergers (filter #(merger-match? % filename)) first second) + default-merger)) ;; TODO: unify with copy-to-jar functionality in jar.clj (for 3.0?) (defn- copy-entries - "Copies the entries of ZipFile in to the ZipOutputStream out, skipping - the entries which satisfy skip-pred. Returns the names of the - entries copied." - [in out skip-set skip-pred] - (for [file (enumeration-seq (.entries in)) - :let [filename (.getName file)] - :when (not (or (skip-set filename) (skip-pred filename)))] - (do - (.setCompressedSize file -1) ; some jars report size incorrectly - (.putNextEntry out file) - (io/copy (.getInputStream in file) out) - (.closeEntry out) - (.getName file)))) + "Read entries of ZipFile `in` and apply the filename-determined + entry-merging logic captured in `mergers`. The default merger + copies entry contents directly to the ZipOutputStream `out` and + skips subsequent same-named files. Returns new `merged-map` merged + entry map." + [in out mergers merged-map] + (reduce (fn [merged-map file] + (let [filename (.getName file), prev (get merged-map filename)] + (if (identical? ::skip prev) + merged-map + (let [[read-merge] (select-merger mergers filename)] + (assoc merged-map + filename (read-merge in out file prev)))))) + merged-map (enumeration-seq (.entries in)))) -;; we have to keep track of every entry we've copied so that we can -;; skip duplicates. We also collect together all the plexus components so -;; that we can merge them. -(defn- include-dep [out skip-pred [skip-set components] dep] +(defn- include-dep [out mergers merged-map dep] (main/debug "Including" (.getName dep)) (with-open [zipfile (ZipFile. dep)] - [(into skip-set (copy-entries zipfile out skip-set skip-pred)) - (concat components (read-components zipfile))])) + (copy-entries zipfile out mergers merged-map))) (defn write-components "Given a list of jarfiles, writes contents to a stream" [project jars out] - (let [[_ components] (reduce (partial include-dep out - (make-skip-pred project)) - [#{"META-INF/plexus/components.xml"} nil] - jars)] - (when-not (empty? components) - (.putNextEntry out (ZipEntry. "META-INF/plexus/components.xml")) - (binding [*out* (PrintWriter. out)] - (xml/emit {:tag :component-set - :content - [{:tag :components - :content - components}]}) - (.flush *out*)) - (.closeEntry out)))) + (let [mergers (make-mergers project) + include-dep (partial include-dep out mergers) + merged-map (reduce include-dep {} jars)] + (doseq [[filename result] merged-map + :when (not (identical? ::skip result)) + :let [[_ write] (select-merger mergers filename)]] + (write out filename result)))) (defn uberjar "Package up the project files and all dependencies into a jar file. diff --git a/test/leiningen/test/helper.clj b/test/leiningen/test/helper.clj index be0736e8..df9b75e0 100644 --- a/test/leiningen/test/helper.clj +++ b/test/leiningen/test/helper.clj @@ -34,6 +34,8 @@ (def provided-project (read-test-project "provided")) +(def uberjar-merging-project (read-test-project "uberjar-merging")) + (def overlapped-sourcepaths-project (read-test-project "overlapped-sourcepaths")) (def more-gen-classes-project (read-test-project "more-gen-classes")) diff --git a/test/leiningen/test/uberjar.clj b/test/leiningen/test/uberjar.clj index b5d5a40c..30529a33 100644 --- a/test/leiningen/test/uberjar.clj +++ b/test/leiningen/test/uberjar.clj @@ -3,6 +3,7 @@ [clojure.test :refer :all] [clojure.java.shell :refer [sh]] [leiningen.test.helper :refer [sample-no-aot-project + uberjar-merging-project provided-project]]) (:import (java.io File) (java.util.zip ZipFile))) @@ -24,6 +25,22 @@ (is (entries "org/codehaus/janino/Compiler$1.class")) (is (not (some #(re-find #"dummy" %) entries))))))) +(deftest test-uberjar-merge-with + (uberjar uberjar-merging-project) + (let [filename (str "test_projects/uberjar-merging/target/" + "nomnomnom-0.5.0-SNAPSHOT-standalone.jar") + uberjar-file (File. filename)] + (is (= true (.exists uberjar-file))) + (when (.exists uberjar-file) + (.deleteOnExit uberjar-file) + (with-open [zf (ZipFile. uberjar-file)] + (is (= '{nomnomnom/identity clojure.core/identity + mf/i nomnomnom/override + mf/s method.fn/static} + (->> (.getEntry zf "data_readers.clj") + (.getInputStream zf) + slurp read-string))))))) + ;; TODO: this breaks on Java 6 (deftest ^:disabled test-uberjar-provided (let [bootclasspath "-Xbootclasspath/a:leiningen-core/lib/clojure-1.4.0.jar" diff --git a/test_projects/uberjar-merging/project.clj b/test_projects/uberjar-merging/project.clj new file mode 100644 index 00000000..18b417a2 --- /dev/null +++ b/test_projects/uberjar-merging/project.clj @@ -0,0 +1,14 @@ +;; This project is used for leiningen's test suite, so don't change +;; any of these values without updating the relevant tests. If you +;; just want a basic project to work from, generate a new one with +;; "lein new". + +(defproject nomnomnom "0.5.0-SNAPSHOT" + :dependencies [[org.clojure/clojure "1.5.1"] + [janino "2.5.15"] + [org.platypope/method-fn "0.1.0"]] + :uberjar-exclusions [#"DUMMY"] + :test-selectors {:default (fn [m] (not (:integration m))) + :integration :integration + :int2 :int2 + :no-custom (fn [m] (not (false? (:custom m))))}) diff --git a/test_projects/uberjar-merging/resources/data_readers.clj b/test_projects/uberjar-merging/resources/data_readers.clj new file mode 100644 index 00000000..ddb326c0 --- /dev/null +++ b/test_projects/uberjar-merging/resources/data_readers.clj @@ -0,0 +1,3 @@ +{nomnomnom/identity clojure.core/identity, + mf/i nomnomnom/override, + }