simon/smeagol
1
0
Fork 0
mirror of https://github.com/journeyman-cc/smeagol.git synced 2026-04-12 18:05:06 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

Progress on thumbnailing, but not working yet.

Browse source
This commit is contained in:
Simon Brooke 2020-02-10 17:39:24 +00:00
parent 719222195e
commit ad5e41c23a
No known key found for this signature in database
GPG key ID: A7A4F18D1D4DF987
3 changed files with 75 additions and 22 deletions
Download patch file Download diff file Expand all files Collapse all files

1
project.clj
View file

@ -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"]

7
resources/config.edn
View file

@ -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
}}

89
src/smeagol/uploads.clj
View file

@ -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?")))))