Progress on thumbnailing, but not working yet.

project.clj

@@ -16,6 +16,7 @@
                  [environ "1.1.0"]
                  [hiccup "1.0.5"]
                  [im.chit/cronj "1.4.4"]
+                 [image-resizer "0.1.10"]
                  [lib-noir "0.9.9" :exclusions [org.clojure/tools.reader]]
                  [markdown-clj "0.9.99" :exclusions [com.keminglabs/cljx]]
                  [me.raynes/fs "1.4.6"]

resources/config.edn

@@ -42,5 +42,10 @@
                                         ;; from: options are :local, :cloudflare
   :passwd               "resources/passwd"
                                         ;; where the password file is stored
-  :site-title           "Smeagol"}      ;; overall title of the site, used in
+  :site-title           "Smeagol"       ;; overall title of the site, used in
                                         ;; page headings
+  :thumbnails           {:small 64      ;; maximum dimension of thumbnails
+                                        ;; stored in the /small directory
+                         :med 400       ;; maximum dimension of thumbnails
+                                        ;; stored in the /med directory
+                         }}

src/smeagol/uploads.clj

@@ -1,10 +1,18 @@
 (ns ^{:doc "Handle file uploads."
       :author "Simon Brooke"}
   smeagol.uploads
-  (:import [java.io File])
   (:require [clojure.string :as cs]
-            [noir.io :as io]
-            [taoensso.timbre :as timbre]))
+            [clojure.java.io :as io]
+            [image-resizer.core :refer [resize]]
+            [image-resizer.util :refer :all]
+            [me.raynes.fs :as fs]
+            [smeagol.configuration :refer [config]]
+            [taoensso.timbre :as log])
+  (:import [java.io File]
+           [java.awt Image]
+           [java.awt.image RenderedImage BufferedImageOp]
+           [javax.imageio ImageIO ImageWriter ImageWriteParam IIOImage]
+           [javax.imageio.stream FileImageOutputStream]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;
@@ -29,21 +37,59 @@
 ;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-;; No longer used as uploaded files now go into Git.
-;; (defn avoid-name-collisions
-;;   "Find a filename within this `path`, based on this `file-name`, that does not
-;;    reference an existing file. It is assumed that `path` ends with a path separator.
-;;    Returns a filename hwich does not currently reference a file within the path."
-;;   [path file-name]
-;;   (if (.exists (File. (str path file-name)))
-;;     (let [parts (cs/split file-name #"\.")
-;;           prefix (cs/join "." (butlast parts))
-;;           suffix (last parts)]
-;;       (first
-;;        (filter #(not (.exists (File. (str path %))))
-;;                (map #(str prefix "." % "." suffix) (range)))))
-;;     file-name))
+(def image-file-extns
+  "Extensions of file types we will attempt to thumbnail. GIF is excluded
+  because by default the javax.imageio package can read GIF, PNG, and JPEG
+  images but can only write PNG and JPEG images."
+  #{".jpg" ".jpeg" ".png"})
 
+(defn read-image
+  "Reads a BufferedImage from source, something that can be turned into
+  a file with clojure.java.io/file"
+  [source]
+  (ImageIO/read (io/file source)))
+
+(defn write-image
+  "Writes img, a RenderedImage, to dest, something that can be turned into
+  a file with clojure.java.io/file.
+  Takes the following keys as options:
+      :format  - :gif, :jpg, :png or anything supported by ImageIO
+      :quality - for JPEG images, a number between 0 and 100"
+  [^RenderedImage img dest & {:keys [format quality] :or {format :jpg}}]
+  (if (or (not quality) (not (contains? #{:jpg :jpeg} format)))
+    (ImageIO/write img (name format) (io/file dest))
+    (let [fmt (rest (fs/extension (cs/lower-case dest)))
+          iw (doto ^ImageWriter (first
+                                  (iterator-seq
+                                    (ImageIO/getImageWritersByFormatName
+                                      "jpeg")))
+               (.setOutput (FileImageOutputStream. (io/file dest))))
+          iw-param (doto ^ImageWriteParam (.getDefaultWriteParam iw)
+                     (.setCompressionMode ImageWriteParam/MODE_EXPLICIT)
+                     (.setCompressionQuality (float (/ quality 100))))
+          iio-img (IIOImage. img nil nil)]
+      (.write iw nil iio-img iw-param))))
+
+(defn auto-thumbnail
+  "For each of the thumbnail sizes in the configuration, create a thumbnail
+  for the file with this `filename` on this `path`, provided that it is a
+  scalable image and is larger than the size."
+  ([^String path ^String filename]
+    (if
+      (image-file-extns (fs/extension (cs/lower-case filename)))
+      (let [original (buffered-image (.File (str path filename)))] ;; fs/file?
+        (map
+          #(auto-thumbnail path filename % original)
+          (keys (config :thumbnails))))
+      (log/info filename " cannot be thumbnailed.")))
+  ([^String path ^String filename size ^RenderedImage image]
+   (let [s (-> config :thumbnails size)
+         d (dimensions image)]
+     (if (and (integer? s) (some #(> % s) d))
+       (do
+         (write-image (resize image s s) (io/file path (name size) filename))
+         (log/info "Created a " size " thumbnail of " filename))
+       (log/info filename "is smaller than " s "x" s " and was not scaled to " size)))))
 
 (defn store-upload
   "Store an upload both to the file system and to the database.
@@ -56,17 +102,18 @@
   (let [upload (:upload params)
         tmp-file (:tempfile upload)
         filename (:filename upload)]
-    (timbre/info
+    (log/info
       (str "Storing upload file: " upload))
-    (timbre/debug
+    (log/debug
       (str "store-upload mv file: " tmp-file " to: " path filename))
     (if tmp-file
       (try
         (do
           (.renameTo tmp-file
-                     (File. (str path filename)))
+                     (File. (str path filename))) ;; TODO: fs/file
+          (auto-thumbnail path filename)
           (File. (str path filename)))
         (catch Exception x
-          (timbre/error (str "Failed to move " tmp-file " to " path filename "; " (type x) ": " (.getMessage x)))
+          (log/error (str "Failed to move " tmp-file " to " path filename "; " (type x) ": " (.getMessage x)))
           (throw x)))
       (throw (Exception. "No file found?")))))