Created
December 3, 2008 23:44
-
-
Save wilkes/31765 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(ns fnord.jetty | |
(:import (javax.servlet.http HttpServletResponse) | |
(org.mortbay.jetty HttpConnection Request Response Server) | |
(org.mortbay.jetty.bio SocketConnector) | |
(org.mortbay.jetty.handler AbstractHandler))) | |
(def *dispatch-table* (ref {})) | |
(def *server* (Server.)) | |
(defstruct webctx :target :request :response :dispatch) | |
(defn jetty-request [request] | |
(if (instance? Request request) | |
request | |
(.. HttpConnection getCurrentConnection getRequest))) | |
(defn lookup-action [target] | |
(let [not-found (fn [args] | |
(.setStatus (args :response) HttpServletResponse/SC_NOT_FOUND) | |
(println "404 " (args :target) " not found"))] | |
(get @*dispatch-table* target not-found))) | |
(def simple-handler | |
(proxy [AbstractHandler] [] | |
(handle [target request response dispatch] | |
(let [ctx (struct webctx | |
target request response dispatch)] | |
(.setHandled (jetty-request request) true) | |
(doto response | |
(.setContentType "text/html") | |
(.setStatus HttpServletResponse/SC_OK)) | |
(binding [*out* (.getWriter response)] | |
((lookup-action target) ctx)))))) | |
(defn start-server [port] | |
(let [connectors (into-array [(doto (SocketConnector.) (.setPort port))])] | |
(doto *server* | |
(.setConnectors connectors) | |
(.setHandler simple-handler) | |
(.start)))) | |
(defn route [target func] | |
(dosync (commute *dispatch-table* conj {target func}))) | |
(comment | |
(do | |
(route "/hello-world" #(println (str "<h1>Hello, World!</h1>" %))) | |
(start-server 8080))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment