Factored common servlet code out into ring.util.servlet

@@ -1,94 +1,27 @@
 (ns ring.adapter.jetty
-  (:import (javax.servlet.http HttpServletRequest HttpServletResponse)
-           (org.mortbay.jetty.handler AbstractHandler)
-           (org.mortbay.jetty Server)
-           (java.io File FileInputStream InputStream OutputStream)
-           (org.apache.commons.io IOUtils))
-  (:use (clojure.contrib fcase except)))
-
-(defn- build-req-map
-  "Returns a map representing the given Servlet request, to be passed as the
-  Ring request to an app."
-  [#^HttpServletRequest request]
-  {:server-port        (.getServerPort request)
-   :server-name        (.getServerName request)
-   :remote-addr        (.getRemoteAddr request)
-   :uri                (.getRequestURI request)
-   :query-string       (.getQueryString request)
-   :scheme             (keyword (.getScheme request))
-   :request-method     (keyword (.toLowerCase (.getMethod request)))
-   :headers            (reduce
-                          (fn [header-map #^String header-name]
-                            (assoc header-map
-                              (.toLowerCase header-name)
-                              (.getHeader request header-name)))
-                          {}
-                          (enumeration-seq (.getHeaderNames request)))
-   :content-type       (.getContentType request)
-   :content-length     (let [len (.getContentLength request)]
-                         (if (>= len 0) len))
-   :character-encoding (.getCharacterEncoding request)
-   :body               (.getInputStream request)})
-
-(defn- apply-resp-map
-  "Apply the given response map to the servlet response, therby completing
-  the HTTP response."
-  [#^HttpServletResponse response {:keys [status headers body]}]
-  ; Apply the status.
-  (.setStatus response status)
-  ; Apply the headers.
-  (doseq [[key val-or-vals] headers]
-    (if (string? val-or-vals)
-      (.setHeader response key val-or-vals)
-      (doseq [val val-or-vals]
-        (.addHeader response key val))))
-  ; Some headers must be set through specific methods
-  (when-let [content-type (get headers "Content-Type")]
-    (.setContentType response content-type))
-  ; Apply the body - the method depends on the given body type.
-  (cond
-    (string? body)
-      (with-open [writer (.getWriter response)]
-        (.println writer body))
-    (seq? body)
-      (with-open [writer (.getWriter response)]
-        (doseq [chunk body]
-          (.print writer (str chunk))))
-    (instance? InputStream body)
-      (let [#^InputStream in body]
-        (with-open [out (.getOutputStream response)]
-          (IOUtils/copy in out)
-          (.close in)
-          (.flush out)))
-    (instance? File body)
-      (let [#^File f body]
-        (with-open [fin (FileInputStream. f)]
-          (with-open [out (.getOutputStream response)]
-            (IOUtils/copy fin out)
-            (.flush out))))
-    (nil? body)
-      nil
-    :else
-      (throwf "Unreceognized body: %s" body)))
+  (:import (org.mortbay.jetty.handler AbstractHandler)
+           (org.mortbay.jetty Server))
+  (:use (ring.util servlet)
+        (clojure.contrib except)))
 
 (defn- proxy-handler
-  "Returns an Handler implementation for the given app."
-  [app]
+  "Returns an Jetty Handler implementation for the given Ring handler."
+  [handler]
   (proxy [AbstractHandler] []
     (handle [target request response dispatch]
-      (let [req   (build-req-map request)
-            resp  (app req)]
-        (apply-resp-map response resp)
+      (let [request-map  (build-request-map request)
+            response-map (handler request-map)]
+        (update-servlet-response response response-map)
         (.setHandled request true)))))
 
 (defn run-jetty
-  "Serve the given app according to the options.
+  "Serve the given handler according to the options.
   Options:
     :port, an Integer."
-  [app options]
+  [handler options]
   (let [port    (or (:port options) (throwf ":port missing from options"))
         server  (doto (Server. port) (.setSendDateHeader true))
-        handler (proxy-handler app)]
+        handler (proxy-handler handler)]
     (.setHandler server handler)
     (.start server)
     (.join  server)))

@@ -0,0 +1,134 @@
+(ns ring.util.servlet
+  "Compatibility functions for turning a ring handler into a Java servlet."
+  (:import (java.io File InputStream FileInputStream)
+           (javax.servlet.http HttpServlet HttpServletRequest HttpServletResponse)
+           (org.apache.commons.io IOUtils))
+  (:use (clojure.contrib except)))
+
+(defn- get-headers
+  "Creates a name/value map of all the request headers."
+  [#^HttpServletRequest request]
+  (reduce
+    (fn [headers, #^String name]
+      (assoc headers
+        (.toLowerCase name)
+        (.getHeader request name)))
+    {}
+    (enumeration-seq (.getHeaderNames request))))
+
+(defn- get-content-length
+  "Returns the content length, or nil if there is no content."
+  [#^HttpServletRequest request]
+  (let [length (.getContentLength request)]
+    (if (>= length 0) length)))
+
+(defn build-request-map
+  "Create the request map from the HttpServletRequest object."
+  [#^HttpServletRequest request]
+  {:server-port        (.getServerPort request)
+   :server-name        (.getServerName request)
+   :remote-addr        (.getRemoteAddr request)
+   :uri                (.getRequestURI request)
+   :query-string       (.getQueryString request)
+   :scheme             (keyword (.getScheme request))
+   :request-method     (keyword (.toLowerCase (.getMethod request)))
+   :headers            (get-headers request)
+   :content-type       (.getContentType request)
+   :content-length     (get-content-length request)
+   :character-encoding (.getCharacterEncoding request)
+   :body               (.getInputStream request)})
+
+(defn merge-servlet-keys
+  "Associate servlet-specific keys with the request map for use with legacy
+  systems."
+  [request-map
+   #^HttpServlet servlet
+   #^HttpServletRequest request
+   #^HttpServletResponse response]
+  (merge request-map
+    {:servlet          servlet
+     :servlet-request  request
+     :servlet-response response
+     :servlet-context  (.getServletContext servlet)}))
+
+(defn- set-headers
+  "Update a HttpServletResponse with a map of headers."
+  [#^HttpServletResponse response, headers]
+  (doseq [[key val-or-vals] headers]
+    (if (string? val-or-vals)
+      (.setHeader response key val-or-vals)
+      (doseq [val val-or-vals]
+        (.addHeader response key val))))
+  ; Some headers must be set through specific methods
+  (when-let [content-type (get headers "Content-Type")]
+    (.setContentType response content-type)))
+
+(defn- set-body
+  "Update a HttpServletResponse body with a String, ISeq, File or InputStream."
+  [#^HttpServletResponse response, body]
+  (cond
+    (string? body)
+      (with-open [writer (.getWriter response)]
+        (.println writer body))
+    (seq? body)
+      (with-open [writer (.getWriter response)]
+        (doseq [chunk body]
+          (.print writer (str chunk))
+          (.flush writer)))
+    (instance? InputStream body)
+      (with-open [out (.getOutputStream response)]
+        (IOUtils/copy body out)
+        (.close body)
+        (.flush out))
+    (instance? File body)
+      (with-open [stream (FileInputStream. body)]
+        (set-body response stream))
+    (nil? body)
+      nil
+    :else
+      (throwf "Unrecognized body: %s" body)))
+
+(defn update-servlet-response
+  "Update the HttpServletResponse using a response map."
+  [#^HttpServletResponse response, {:keys [status headers body]}]
+  (doto response
+    (.setStatus status)
+    (set-headers headers)
+    (set-body body)))
+
+(defn make-service-method
+  "Turns a handler into a function that takes the same arguments and has the
+  same return value as the service method in the HttpServlet class."
+  [handler]
+  (fn [#^HttpServlet servlet
+       #^HttpServletRequest request
+       #^HttpServletResponse response]
+    (.setCharacterEncoding response "UTF-8")
+    (let [request-map (-> request
+                        (build-request-map)
+                        (merge-servlet-keys servlet request response))]
+      (if-let [response-map (handler request-map)]
+        (update-servlet-response response response-map)
+        (throw (NullPointerException. "Handler returned nil"))))))
+
+(definline servlet
+  "Create a servlet from a Ring handler. Automatically updates if the handler
+  binding is redefined."
+  [handler]
+  `(proxy [HttpServlet] []
+     (~'service [request# response#]
+       ((make-service-method ~handler)
+          ~'this request# response#))))
+
+(defmacro defservice
+  "Defines a service method with an optional prefix suitable for being used by
+  genclass to compile a HttpServlet class.
+  e.g. (defservice my-routes)
+       (defservice \"my-prefix-\" my-routes)"
+  ([routes]
+   `(defservice "-" ~routes))
+  ([prefix handler]
+   `(defn ~(symbol (str prefix "service"))
+      [servlet# request# response#]
+      ((make-service-method ~handler)
+         servlet# request# response#))))