Clojure program for controlling build status lava lamps

main.clj

;  Copyright (c) 2010 Patrik Fredriksson
;
;  Permission is hereby granted, free of charge, to any person obtaining a copy
;  of this software and associated documentation files (the "Software"), to deal
;  in the Software without restriction, including without limitation the rights
;  to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
;  copies of the Software, and to permit persons to whom the Software is
;  furnished to do so, subject to the following conditions:
;
;  The above copyright notice and this permission notice shall be included in
;  all copies or substantial portions of the Software.
;
;  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
;  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
;  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
;  AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
;  LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;  OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
;  THE SOFTWARE.


(ns com.granular8.lava.main
  (:gen-class
    :name com.granular8.lava.Main)
  (:use [clojure.xml :only (parse)]
    [clojure.contrib.zip-filter.xml :only (xml1-> text)]
    [clojure.zip :only (xml-zip node)]
    [clojure.contrib.java-utils :only (read-properties)]
    [clojure.contrib.shell-out :only (sh)])
  (:import [it.sauronsoftware.cron4j Scheduler]))

(def *debug* true)


;Map Team City feed build states to our internal
(def build-states {"Successful Build" :successful, "Build Failed" :failed})


(def current-build-state (atom :unknown))


(def switch-lamp)


(defn setup-switch-lamp [{path "switch-control-path"}]
  (let [switch-cmd {:red "-red", :green "-green", :on "-on", :off "-off"}]
    (fn [coll]
      (dorun
        (for [[color state] coll]
          (do
            (if *debug* (println (switch-cmd state) "-lava" (switch-cmd color)))
            (sh path (switch-cmd state) "-lava" (switch-cmd color))))))))


(defn fetch-xml [uri] (xml-zip (parse uri)))


(defn retrieve-status [uri] (build-states (xml1-> (fetch-xml uri) :entry :dc:creator text)))


(defn update-lights [state]
  (do
    (println "switching state")
    (if (= state :successful)
      (switch-lamp {:red :off, :green :on})
      (switch-lamp {:green :off, :red :on}))))

(defn turnoff-lights []
  "Update build state, turn off lights"
  (do
    (reset! current-build-state :unknown)
    (switch-lamp {:green :off, :red :off})))


(defn tc-check
  "Retrieve state from uri resource, update local state info and adjust lights accordingly.
Note that since we cannot update the state _and_ control the lamps in a transaction
(damnn you non-transactional lava lamps!), theoretically we could get into trouble here,
in practice it won't be a problem."
  [{uri "uri"}]
  (try
    (let [old @current-build-state
          new (reset! current-build-state (retrieve-status uri))]
      (do
        (if-not (= old new)
          (update-lights new))
        (if *debug* (println (format "Checking: %1$tY-%1$tm-%1$td %1$tH:%1$tM:%1$tS" (java.util.GregorianCalendar.))))))
    (catch Exception e
      (do
        (println "Failed to update build light state." e)
        (reset! current-build-state :unknown)))))


(defn startup [settings-path]
  (let [settings (read-properties settings-path)]
    (do

      (def switch-lamp (setup-switch-lamp settings))

      (doto (Scheduler.)
        (.schedule (get settings "monitor-pattern") #(tc-check settings))
        (.start))

      (doto (Scheduler.)
        (.schedule (get settings "off-pattern") turnoff-lights)
        (.start)))))


(defn -main [& args]
  (if (= 1 (count args))
    (startup (first args))
    (println "Requires /path/to/settings.properties file as argument")))

project.clj

(defproject lava2009 "1.0.0-SNAPSHOT"
  :description "Simple Clojure project to control lava lights"
  :dependencies [[org.clojure/clojure "1.1.0"]
                 [org.clojure/clojure-contrib "1.1.0-master-SNAPSHOT"]
                 [it.sauronsoft/cron4j "2.2.1"]]
  :main com.granular8.lava.Main)