dispatcher.clj

(ns fjord
  (:import (javax.servlet.http HttpServletResponse)
	   (org.mortbay.jetty HttpConnection Request Server HttpException)
	   (org.mortbay.jetty.bio SocketConnector)
	   (org.mortbay.jetty.handler AbstractHandler)))

(defstruct webctx :target :request :response :dispatch)

(def *routes* (atom []))

(defn dispatch
  ([ctx]
     (dispatch @*routes* ctx))
  ([routes ctx]
     (let [[rx f] (first routes)
	   parsed (re-find rx (ctx :target))]
       (if parsed
	 (if (string? parsed)
	   (f ctx)
	   (apply f ctx (rest parsed)))
	 (if (empty? (rest routes))
	   (throw (HttpException. 404
				  (str "Unable to find resource for " (ctx :target))))
	   (recur (rest routes) ctx))))))

(defn route [rx f] (swap! *routes* conj [rx f]))

(defn jetty-request [request]
  (if (instance? Request request)
    request
    (.. HttpConnection getCurrentConnection getRequest)))

(def rx-handler
     (proxy [AbstractHandler] []
       (handle [target request response dispatch-int]
	       (let [ctx (struct webctx 
				 target request response dispatch-int)]
		 (.setHandled (jetty-request request) true)
		 (doto response
		   (.setContentType "text/html")
		   (.setStatus HttpServletResponse/SC_OK))
		 (binding [*out* (.getWriter response)]
		   (dispatch ctx))))))

(defn start-server
  ([port]
     (start-server port rx-handler))
  ([port handler]
     (let [connectors (into-array [(doto (SocketConnector.) (.setPort port))])
	   server (new Server)]
       (doto server
	 (.setConnectors connectors)
	 (.setHandler handler)
	 (.start))
       server)))


(defn pining-app []
  (route #"/parrot/dead.*"
	 (fn [ctx]
	   (println "It's probably pining for the fjords.")))
  (route #"/parrot/(.*)"
	 (fn [ctx type]
	   (println (str "Remarkable bird the Norwegian " type ". "
			"Beautiful plummage isn't it?")))))
(comment
  (do
    (def s (start-server 8080))
    (pining-app)
    (defn stop-pining [] (.stop s))))