1 files changed, 129 insertions, 0 deletions
diff --git a/compojure-3.2/src/compojure/http/servlet.clj b/compojure-3.2/src/compojure/http/servlet.clj
new file mode 100755
index 0000000..b6eef26
--- /dev/null
+++ b/compojure-3.2/src/compojure/http/servlet.clj
@@ -0,0 +1,129 @@
+;; Copyright (c) James Reeves. All rights reserved.
+;; The use and distribution terms for this software are covered by the Eclipse
+;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which
+;; can be found in the file epl-v10.html at the root of this distribution. By
+;; using this software in any fashion, you are agreeing to be bound by the
+;; terms of this license. You must not remove this notice, or any other, from
+;; this software.
+
+(ns compojure.http.servlet
+  "Functions for interfacing Compojure with the Java servlet standard."
+  (:use compojure.http.routes
+        compojure.http.request)
+  (:import [java.io File InputStream FileInputStream]
+           java.util.Map$Entry
+           [javax.servlet.http Cookie HttpServlet HttpServletRequest HttpServletResponse]
+           javax.servlet.ServletContext
+           org.apache.commons.io.IOUtils))
+
+;; Functions to pull information from the request object
+
+(defn- get-headers
+  "Creates a name/value map of all the request headers."
+  [#^HttpServletRequest request]
+  (reduce
+    (fn [headers 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 create-request
+  "Create the request map from the HttpServletRequest object."
+  [#^HttpServletRequest request, #^HttpServlet servlet]
+  {: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)
+   ;; Custom non-Ring field:
+   :servlet-request    request
+   :servlet-context    (.getServletContext servlet)})
+
+;; Functions to set data in the response object
+
+(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))))
+
+(defn update-servlet-response
+  "Update the HttpServletResponse using a response map."
+  [#^HttpServletResponse response, {:keys [status headers body]}]
+  (.setStatus  response status)
+  (set-headers response headers)
+  (set-body    response body))
+
+;; Functions that combine request and response handling
+
+(defn request-handler
+  "Handle incoming HTTP requests from a servlet."
+  [[servlet request response] routes]
+  (.setCharacterEncoding response "UTF-8")
+  (if-let [response-map (routes (create-request request servlet))]
+    (update-servlet-response response response-map)
+    (throw (NullPointerException. 
+             "Handler returned nil (maybe no routes matched URI)"))))
+
+(definline servlet
+  "Create a servlet from a sequence of routes. Automatically updates if
+  the routes binding is redefined."
+  [routes]
+  `(proxy [HttpServlet] []
+     (~'service [request# response#]
+       (request-handler [~'this request# response#]
+         ~routes))))
+
+(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 routes]
+   `(defn ~(symbol (str prefix "service"))
+      [servlet# request# response#]
+      (request-handler [servlet# request# response#]
+        ~routes))))