path: root/src/utils.clj

(ns utils
  (:import java.text.SimpleDateFormat
           java.util.Date
           java.util.TimeZone
           java.io.File
           java.net.URLDecoder
           org.apache.commons.codec.digest.DigestUtils
           org.antlr.stringtemplate.StringTemplateGroup)
  (:use clojure.contrib.json.write
        clojure.contrib.sql
        clojure.contrib.str-utils
        compojure))

(let [db-host "localhost"
      db-port 5432
      db-name "dumpfm"]
  (def *db* {:classname "org.postgresql.Driver"
             :subprotocol "postgresql"
             :subname (str "//" db-host ":" db-port "/" db-name)
             :user "postgres"
             :password "root"}))

;;  moved this to here which doesn't seem right... maybe a 'settings.clj' or something?
(def *dumps-per-page* 20)

;; Misc

(declare stringify-and-escape)
(defn escape-html-deep [o]
  (if (map? o)
      (stringify-and-escape o)
      (if (seq? o)
          (map escape-html-deep o)
          (escape-html o))))

(defn stringify-and-escape [m]
  (zipmap (map str* (keys m)) (map escape-html-deep (vals m))))

(defn nor [& args]
  (not-any? identity args))

(defn no-args-adaptor [f]
  (fn [& more] (f)))

(defn ms-in-future [ms]
  (+ ms (System/currentTimeMillis)))

(defn swap [f]
  (fn [& more] (apply f (reverse more))))

(defn join [lst int]
  (apply str (interpose int lst)))

(defn non-empty-string? [s]
  (cond (string? s) (> (count s) 0)
        :else s))

(defn seconds [t] (* t 1000))
(defn minutes [t] (* 60 (seconds t)))
(defn hours   [t] (* 60 (minutes t)))
(defn days    [t] (* 24 (hours t)))

(defn ms-ago [ms]
  (- (System/currentTimeMillis) ms))

(defn kbytes [b] (* b 1024))
(defn mbytes [b] (* b 1024 1024))

(defn open-file [dir-comps filename]
  (let [d (str-join (System/getProperty "file.separator")
                    dir-comps)
        f (str-join (System/getProperty "file.separator")
                    [d filename])]
    (.mkdir (new File d))
    (new File f)))

(defn sha1-hash [& more]
  (DigestUtils/shaHex (apply str more)))

(defmacro with-timing [e] 
  `(let [s# (System/nanoTime)
         r# ~e
         f# (System/nanoTime)]
     [(int (/ (- f# s#) 1000000.0)) r#]))


;; Formatters

(def yyyy-mm-dd-formatter (new SimpleDateFormat "yyyy-MM-dd"))

(defn format-yyyy-mm-dd [d]
  (.format yyyy-mm-dd-formatter d))

(def yymmdd-formatter (new SimpleDateFormat "yyyyMMdd"))

(defn format-yyyymmdd [d]
  (.format yymmdd-formatter d))

(defn today []
  (format-yyyymmdd (new Date)))

(def timestamp-formatter (new SimpleDateFormat "h:mm a EEE M/d"))
(def date-first-timestamp-formatter (new SimpleDateFormat "M/d h:mm a"))

(defn format-timestamp [d]
  (.format timestamp-formatter d))

(defn format-date-first-timestamp [d]
  (.format date-first-timestamp-formatter d))

(defn pluralize [word val]
  (if (= val 1) word (str word "s")))

(defn format-interval [i]
  (let [vals    [(.getYears i)
                 (.getMonths i)
                 (.getDays i)
                 (.getHours i)
                 (.getMinutes i)]
        labels  ["year" "month" "day" "hour" "minute"]
        arr     (into [] (for [[l v] (map vector labels vals) :when (> v 0)]
                           (str v " " (pluralize l v))))]
    (join arr ", ")))

(defn apply-formats [formats d]
  (into {} (for [[k v] d]
             (if-let [f  (formats k)]
               [k (f v)]
               [k v]))))

(defn gmt-string
  ([] (gmt-string (new Date)))
  ([dt]
     (let [df (new SimpleDateFormat "EEE, dd MMM yyyy kk:mm:ss z")]
       (.setTimeZone df (TimeZone/getTimeZone "GMT"))
       (.format df dt))))

;; JSON responses

(defmethod print-json Date
  [d]
  (print-json (format-yyyy-mm-dd d)))

(defn resp-error [message]
  {:status 400 :headers {} :body message})

(defn resp-success [message]
  {:status 200 :headers {} :body (json-str message)})

;; Database

(defn do-cmds [query]
  (with-connection *db*
    (do-commands query)))

(defn do-prepared! [& args]
  (with-connection *db*
    (apply do-prepared args)))

(defn do-update [& args]
  (with-connection *db*
    (apply update-values args)))

(defn do-select [query]
  (with-connection *db*
    (with-query-results rs query
      (doall rs))))

(defn do-count [query]
  ((first (with-connection *db*
	    (with-query-results rs query
	      (doall rs))))
   :count))

(defn do-delete [table query]
  (with-connection *db*
    (delete-rows table query)))

(defn do-insert [table cols values]
  (with-connection *db*
    (insert-values table cols values)))

(defn assert-update
  ([res ok err] (if (not (= (first res) 1)) err ok))
  ([res] (assert-update res true false)))

;; Parsing

(defn maybe-parse-int 
  ([s] (Integer/parseInt s))
  ([s default]
     (try (Integer/parseInt s)
          (catch NumberFormatException _ default))))

(defn maybe-parse-long [s f]
  (if s (Long/parseLong s) f))

(defn url-decode [text]
  (URLDecoder/decode text "UTF-8"))

(defn #^String lower-case
  "Converts string to all lower-case."
  [#^String s]
  (.toLowerCase s))

;; 404

(defn unknown-page [& more]
  [404 "Page not Found"])

;; Templates

(def template-group (new StringTemplateGroup "dumpfm" "template"))
(.setRefreshInterval template-group 3)

; TODO: handle exception, clean-up template setting
(defn fetch-template [template session]
  (let [st (.getInstanceOf template-group template)]
    (if (session :nick)
      (do (.setAttribute st "user_email" (session :email))
          (.setAttribute st "user_nick" (session :nick))
          (if (non-empty-string? (session :avatar)) 
            (.setAttribute st "user_avatar" (session :avatar)))
          (.setAttribute st "isadmin" (session :is_admin))))
    st))

(defn serve-template [template session]
  (.toString (fetch-template template session)))

(defn first-or-nil [l]
  (if (empty? l) nil (first l)))

;; VIP

(defn is-vip? [session]
  (session :is_admin))

(defmacro if-vip [e]
  "Evaluates expr if user is vip otherwise returns 404. Can only be used
   where session is defined."
  `(if (is-vip? ~'session) ~e (unknown-page)))