Merge branch 'jar-directory-entries' of https://github.com/dm3/leiningen

src/leiningen/jar.clj

@@ -47,12 +47,11 @@
     (zipmap (map str (keys attrs)) (vals attrs))))
 
 (defn- skip-file?
-  "Skips the file if it doesn't exists or is a directory. If the file is not the
+  "Skips the file if it doesn't exist. If the file is not the
   root-file (specified by :path), will also skip it if it is a dotfile, emacs
   backup file or matches an exclusion pattern."
   [file relative-path root-file patterns]
   (or (not (.exists file))
-      (.isDirectory file)
       (and
        (not= file root-file)
        (or
@@ -62,11 +61,15 @@
 
 (defmulti ^:private copy-to-jar (fn [project jar-os acc spec] (:type spec)))
 
-(defn- trim-leading [s to-trim]
+(defn- relativize [path root-path]
-  (let [size (.length to-trim)]
+  (if (.startsWith path root-path)
-    (if (.startsWith s to-trim)
+    (.substring path (.length root-path))
-      (.substring s size)
+    path))
-      s)))
+
+(defn- full-path [file path]
+  (if (.isDirectory file)
+    (str path "/")
+    path))
 
 (defn- dir-string
   "Returns the file's directory as a string, or the string representation of the
@@ -76,21 +79,34 @@
     (str (.getParent file) "/")
     (str file "/")))
 
+(defn- put-jar-entry [jar file path]
+  (.putNextEntry jar (doto (JarEntry. path)
+                          (.setTime (.lastModified file)))))
+
+(defn- path-goes-into-jar?
+  "Checks if the path has already been added to the jar and prints warning
+  if it has. Otherwise checks if path isn't excluded."
+  [relative-path file seen-paths root-file exclusion-patterns]
+  ; Path may be blank if it's the root path
+  (if (or (string/blank? relative-path) (seen-paths relative-path))
+    (when-not (.isDirectory file)
+      (main/info "Warning: skipped duplicate file:" relative-path)
+      false)
+    (not (skip-file? file relative-path root-file exclusion-patterns))))
+
 (defmethod copy-to-jar :path [project jar-os acc spec]
   (let [root-file (io/file (:path spec))
         root-dir-path (unix-path (dir-string root-file))
         paths (for [child (file-seq root-file)
-                    :let [path (trim-leading (unix-path (str child))
+                    :let [path (relativize
-                                             root-dir-path)]]
+                                 (full-path child (unix-path (str child)))
-                (when-not (skip-file? child path root-file
+                                 root-dir-path)]
-                                      (:jar-exclusions project))
+                    :when (path-goes-into-jar?
-                  (if (acc path)
+                            path child acc root-file (:jar-exclusions project))]
-                    (main/info "Warning: skipped duplicate file:" path)
+                (do (put-jar-entry jar-os child path)
-                    (do
+                    (when (not (.isDirectory child))
-                      (.putNextEntry jar-os (doto (JarEntry. path)
+                      (io/copy child jar-os))
-                                              (.setTime (.lastModified child))))
+                    path))]
-                      (io/copy child jar-os)
-                      path))))]
     (into acc paths)))
 
 (defmethod copy-to-jar :paths [project jar-os acc spec]

test/leiningen/test/helper.clj

@@ -20,6 +20,8 @@
        (project/project-with-profiles-meta
          project (merge @project/default-profiles (:profiles project)))))))
 
+(def with-resources-project (read-test-project "with-resources"))
+
 (def sample-project (read-test-project "sample"))
 
 (def sample-failing-project (read-test-project "sample_failing"))
@@ -77,3 +79,10 @@ because if not absolute then .getAbsolutePath will resolve them relative to curr
     (throw (new RuntimeException (str "bad usage, passed: `" in-str-or-file "`")))
     :else
     (.getAbsolutePath (io/as-file in-str-or-file))))
+
+(defn entries [zipfile]
+  (enumeration-seq (.entries zipfile)))
+
+(defn walkzip [fileName f]
+  (with-open [z (java.util.zip.ZipFile. fileName)]
+    (reduce #(conj %1 (f %2)) [] (entries z))))

test/leiningen/test/jar.clj

@@ -6,7 +6,8 @@
         [leiningen.core.eval :only [platform-nullsink]]
         [leiningen.test.helper :only [tricky-name-project sample-failing-project
                                       sample-no-aot-project sample-project
-                                      overlapped-sourcepaths-project]])
+                                      overlapped-sourcepaths-project
+                                      with-resources-project walkzip]])
   (:import (java.util.jar JarFile)))
 
 (def long-line
@@ -32,6 +33,13 @@
   (binding [*err* (java.io.PrintWriter. (platform-nullsink))]
     (is (thrown? Exception (jar sample-failing-project)))))
 
+(deftest test-directory-entries-added-to-jar
+  (with-out-str
+    (let [jar (first (vals (jar with-resources-project)))
+          entry-names (set (walkzip jar #(.getName %)))]
+      (is (entry-names "nested/dir/"))
+      (is (not (some #(.startsWith % "/") entry-names))))))
+
 (deftest test-no-aot-jar-succeeds
   (with-out-str
     (is (jar sample-no-aot-project))))

test_projects/with-resources/project.clj

@@ -0,0 +1,10 @@
+;; 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 project-with-resources "0.5.0-SNAPSHOT"
+  :dependencies [[org.clojure/clojure "1.3.0"]
+                 [janino "2.5.15"]]
+
+  :resource-paths ["resources"])

test_projects/with-resources/resources/nested/dir/sample.txt

@@ -0,0 +1 @@
+Do not remove me!