Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
Clojure program for controlling build status lava lamps
; 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")))
(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)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment