Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Merge branch '0.4'

  • Loading branch information...
commit 6f21014f2c28f7d551551e40bc17cae1958e96bb 2 parents 4008389 + 4c1f6b5
James Reeves authored
Showing with 211 additions and 3,323 deletions.
  1. +1 −0  .gitignore
  2. +0 −62 README.markdown
  3. +51 −0 README.md
  4. +0 −90 build.xml
  5. +8 −25 project.clj
  6. +0 −29 src/compojure.clj
  7. +0 −73 src/compojure/control.clj
  8. +113 −0 src/compojure/core.clj
  9. +0 −129 src/compojure/crypto.clj
  10. +0 −64 src/compojure/encodings.clj
  11. +0 −16 src/compojure/html.clj
  12. +0 −169 src/compojure/html/form_helpers.clj
  13. +0 −124 src/compojure/html/gen.clj
  14. +0 −103 src/compojure/html/page_helpers.clj
  15. +0 −19 src/compojure/http.clj
  16. +0 −76 src/compojure/http/helpers.clj
  17. +0 −131 src/compojure/http/middleware.clj
  18. +0 −80 src/compojure/http/multipart.clj
  19. +0 −109 src/compojure/http/request.clj
  20. +0 −106 src/compojure/http/response.clj
  21. +0 −243 src/compojure/http/routes.clj
  22. +0 −129 src/compojure/http/servlet.clj
  23. +0 −243 src/compojure/http/session.clj
  24. +0 −21 src/compojure/map_utils.clj
  25. +0 −23 src/compojure/ns_utils.clj
  26. +16 −10 src/compojure/{validation/predicates.clj → response.clj}
  27. +0 −26 src/compojure/server/common.clj
  28. +0 −74 src/compojure/server/grizzly.clj
  29. +0 −106 src/compojure/server/jetty.clj
  30. +0 −86 src/compojure/str_utils.clj
  31. +0 −91 src/compojure/validation.clj
  32. +22 −0 test/compojure/core_test.clj
  33. +0 −35 test/compojure/crypto_test.clj
  34. +0 −118 test/compojure/html/form_helpers_test.clj
  35. +0 −93 test/compojure/html/gen_test.clj
  36. +0 −71 test/compojure/html/page_helpers_test.clj
  37. +0 −21 test/compojure/http/helpers_test.clj
  38. +0 −115 test/compojure/http/middleware_test.clj
  39. +0 −51 test/compojure/http/request_test.clj
  40. +0 −46 test/compojure/http/response_test.clj
  41. +0 −168 test/compojure/http/routes_test.clj
  42. +0 −73 test/compojure/http/session_test.clj
  43. +0 −7 test/compojure/str_utils_test.clj
  44. +0 −37 test/compojure/validation_test.clj
  45. +0 −14 test/helpers.clj
  46. +0 −17 test/run.clj
1  .gitignore
View
@@ -1,5 +1,6 @@
lib
classes
+lib
compojure.jar
deps
deps.zip
62 README.markdown
View
@@ -1,62 +0,0 @@
-Compojure is an open source web framework for the [Clojure](http://clojure.org)
-programming language. It emphasizes a thin I/O layer and a functional approach
-to web development.
-
-Compojure is still in active development. The current stable branch has been
-released as version 0.3.1.
-
-Sample Code
------------
-
-Here's a small web application written in Compojure:
-
- (use 'compojure)
-
- (defroutes my-app
- (GET "/"
- (html [:h1 "Hello World"]))
- (ANY "*"
- (page-not-found)))
-
- (run-server {:port 8080}
- "/*" (servlet my-app))
-
-Dependencies
-------------
-
-To run Compojure, you'll need:
-
-* The [Clojure](http://clojure.org) programming language
-* The [Clojure-Contrib](http://code.google.com/p/clojure-contrib/) library
-* A Java servlet container like [Jetty](http://www.mortbay.org/jetty/)
-* Apache Commons [FileUpload](http://commons.apache.org/fileupload),
- [IO](http://commons.apache.org/io) and
- [Codec](http://commons.apache.org/codec).
-
-These dependencies can be downloaded automatically using:
-
- ant deps
-
-Documentation
--------------
-
-For information on how to get started and use Compojure, please see our
-[Wiki](http://en.wikibooks.org/wiki/Compojure).
-
-There is also a rough draft of a [Compojure Tutorial](http://groups.google.com/group/compojure/browse_thread/thread/3c507da23540da6e)
-available to read.
-
-Community
----------
-
-The [Compojure Group](http://groups.google.com/group/compojure) is the best place
-to ask questions about Compojure, suggest improvements or to report bugs.
-
-Tutorials
----------
-
-Eric Lavigne has written a series of excellent tutorials on Compojure:
-
-* [Install Compojure on a Slicehost VPS](http://ericlavigne.wordpress.com/2008/12/18/compojure-on-a-slicehost-vps/)
-* [Using PostgreSQL with Compojure](http://ericlavigne.wordpress.com/2008/12/28/using-postgresql-with-compojure/)
-* [Compojure security: authentication and authorization](http://ericlavigne.wordpress.com/2009/01/04/compojure-security-authentication-and-authorization/)
51 README.md
View
@@ -0,0 +1,51 @@
+Compojure is a small, open source web framework for the
+[Clojure](http://clojure.org) programming language.
+
+This is the latest development version of Compojure. For the latest stable
+version, see [0.3.2](http://github.com/weavejester/compojure/tree/0.3.2).
+
+An Example
+----------
+
+Here's a small web application written using Compojure,
+[Ring](http://github.com/mmcgrana/ring) and
+[Hiccup](http://github.com/weavejester/hiccup).
+
+ (ns hello-world
+ (:use [compojure.core :only (defroutes GET ANY)]
+ [hiccup.core :only (html)]
+ [ring.adapter.jetty :only (run-jetty)]
+ [ring.util.response :only (redirect)]))
+
+ (defroutes main-routes
+ (GET "/" []
+ (redirect "/world"))
+ (GET "/:name" [name]
+ (html [:h1 "Hello " name]))
+ (ANY "*" {uri :uri}
+ {:status 404
+ :body (html [:h1 "Page not found: " uri])}))
+
+ (run-jetty main-routes {:port 8080})
+
+
+Installing
+----------
+
+The easiest way to use Compojure in your own projects is via
+[Leiningen](http://github.com/technomancy/leiningen). Add the following
+dependency to your project.clj file:
+
+ [compojure "0.4.0-SNAPSHOT"]
+
+To build Compojure from source, run the following commands:
+
+ lein deps
+ lein jar
+
+
+Mailing List
+------------
+
+Compojure has a [Google Group](http://groups.google.com/group/compojure). This
+is the best place to ask questions and report bugs.
90 build.xml
View
@@ -1,90 +0,0 @@
-<project name="compojure" default="jar">
- <description>
- Compojure library package.
- </description>
-
- <property name="build.dir" location="classes"/>
- <property name="deps.dir" location="deps"/>
- <property name="source.dir" location="src"/>
- <property name="tests.dir" location="test"/>
- <property name="compojure.jar" location="compojure.jar"/>
- <property name="deps.file" value="deps.zip"/>
- <property name="deps.url" value="http://cloud.github.com/downloads/weavejester/compojure/${deps.file}"/>
-
- <path id="classpath">
- <path location="${build.dir}"/>
- <path location="${source.dir}"/>
- <fileset dir="${deps.dir}">
- <include name="*.jar"/>
- </fileset>
- </path>
-
- <target name="clean" description="Remove generated files">
- <delete file="${compojure.jar}"/>
- <delete dir="${build.dir}"/>
- </target>
-
- <target name="init" depends="clean">
- <tstamp/>
- <mkdir dir="${build.dir}"/>
- </target>
-
- <target name="compile" depends="compile-compojure, compile-grizzly-server" description="Compile sources."/>
-
- <target name="compile-compojure" depends="init" description="Compile compojure sources">
- <java classname="clojure.lang.Compile" fork="true">
- <sysproperty key="clojure.compile.path" value="${build.dir}"/>
- <classpath refid="classpath"/>
- <arg value="compojure"/>
- <arg value="compojure.control"/>
- <arg value="compojure.html"/>
- <arg value="compojure.html.gen"/>
- <arg value="compojure.html.form-helpers"/>
- <arg value="compojure.html.page-helpers"/>
- <arg value="compojure.http"/>
- <arg value="compojure.http.routes"/>
- <arg value="compojure.http.request"/>
- <arg value="compojure.http.response"/>
- <arg value="compojure.http.session"/>
- <arg value="compojure.http.servlet"/>
- <arg value="compojure.http.helpers"/>
- <arg value="compojure.ns-utils"/>
- <arg value="compojure.server.common"/>
- <arg value="compojure.server.jetty"/>
- <arg value="compojure.str-utils"/>
- <arg value="compojure.validation"/>
- </java>
- </target>
-
- <target name="compile-grizzly-server" depends="compile-compojure" description="Compile Grizzly server" if="with.grizzly">
- <java classname="clojure.lang.Compile">
- <sysproperty key="clojure.compile.path" value="${build.dir}"/>
- <classpath refid="classpath"/>
- <arg value="compojure.server.grizzly"/>
- </java>
- </target>
-
- <target name="test" description="Run tests">
- <java fork="true" classname="clojure.main" failonerror="true">
- <classpath>
- <path refid="classpath"/>
- <path location="${tests.dir}"/>
- <path location="."/>
- </classpath>
- <arg value="${tests.dir}/run.clj"/>
- </java>
- </target>
-
- <target name="jar" description="Create jar file" depends="compile">
- <jar jarfile="${compojure.jar}">
- <path location="LICENSE"/>
- <fileset dir="${source.dir}" includes="**/*.clj"/>
- <fileset dir="${build.dir}" includes="**/*.class"/>
- </jar>
- </target>
-
- <target name="deps" description="Download dependencies and unzip">
- <get usetimestamp="true" description="Clojure dependencies." src="${deps.url}" dest="${deps.file}"/>
- <unzip src="${deps.file}" dest="."/>
- </target>
-</project>
33 project.clj
View
@@ -1,27 +1,10 @@
-(defproject compojure "0.3.2"
+(defproject compojure "0.4.0-SNAPSHOT"
:description "A concise web framework for Clojure"
+ :url "http://github/weavejester/compojure/tree/refactor"
:dependencies [[org.clojure/clojure "1.1.0"]
- [org.clojure/clojure-contrib "1.0-SNAPSHOT"]
- [commons-codec "1.3"]
- [commons-io "1.4"]
- [commons-fileupload "1.2.1"]
- [org.mortbay.jetty/jetty "6.1.21"]]
- :dev-dependencies [[lein-clojars "0.5.0-SNAPSHOT"]]
- :namespaces [compojure
- compojure.control
- compojure.html
- compojure.html.gen
- compojure.html.form-helpers
- compojure.html.page-helpers
- compojure.http
- compojure.http.routes
- compojure.http.request
- compojure.http.response
- compojure.http.session
- compojure.http.servlet
- compojure.http.helpers
- compojure.ns-utils
- compojure.server.common
- compojure.server.jetty
- compojure.str-utils
- compojure.validation])
+ [org.clojure/clojure-contrib "1.1.0"]
+ [clout "0.2.0-SNAPSHOT"]
+ [ring/ring-core "0.2.0-RC2"]]
+ :dev-dependencies [[lein-clojars "0.5.0-SNAPSHOT"]
+ [ring/ring-jetty-adapter "0.2.0-RC2"]
+ [hiccup "0.2.1"]])
29 src/compojure.clj
View
@@ -1,29 +0,0 @@
-;; 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
- "Convenience library that includes every compojure.* namespace. If you want
- to access Compojure quickly, and don't care about having everything in one
- namespace, just use or require 'compojure."
- (:use compojure.ns-utils))
-
-(immigrate
- 'compojure.control
- 'compojure.html.gen
- 'compojure.html.page-helpers
- 'compojure.html.form-helpers
- 'compojure.http.helpers
- 'compojure.http.middleware
- 'compojure.http.multipart
- 'compojure.http.routes
- 'compojure.http.servlet
- 'compojure.http.session
- 'compojure.server.jetty
- 'compojure.str-utils
- 'compojure.map-utils
- 'compojure.validation)
73 src/compojure/control.clj
View
@@ -1,73 +0,0 @@
-;; 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.control
- "Various macros for controling program flow."
- (:use clojure.contrib.seq-utils))
-
-(defmacro return
- "A do block that will always return the argument 'x'."
- [x & body]
- `(let [x# ~x]
- (do ~@body x#)))
-
-(defmacro maybe
- "Returns (f x & xs) if x is not nil, otherwise returns nil."
- [f x & xs]
- `(if (not (nil? ~x))
- (~f ~x ~@xs)))
-
-(defmacro domap
- "Similar to doseq, but collects the results into a sequence."
- [[item list] & body]
- `(map (fn [~item] ~@body) (doall ~list)))
-
-(defmacro redef
- "Redefine an existing value, keeping the metadata intact."
- [name value]
- `(let [m# (meta #'~name)
- v# (def ~name ~value)]
- (alter-meta! v# merge m#)
- v#))
-
-(defmacro decorate
- "Wrap a function in one or more decorators."
- [func & decorators]
- `(redef ~func (-> ~func ~@decorators)))
-
-(defmacro decorate-with
- "Wrap multiple functions in a decorator."
- [decorator & funcs]
- `(do ~@(for [f funcs]
- `(redef ~f (~decorator ~f)))))
-
-(defmacro decorate-bind
- "Wrap named functions in a decorator for a bounded scope."
- [decorator funcs & body]
- `(binding
- [~@(mapcat (fn [f] [f (list decorator f)]) funcs)]
- ~@body))
-
-(defn apply-doc
- "Return a symbol and body with an optional docstring applied."
- [name doc? body]
- (if (string? doc?)
- (list* (with-meta name (assoc (meta name) :doc doc?)) body)
- (list* name doc? body)))
-
-(defmacro deftmpl
- "Define a template function. Arguments are passed via key-value pairs.
- e.g. (deftmpl foo [bar baz] (+ bar baz))
- (foo :bar 1 :baz 2)"
- [name doc? & body]
- (let [[name params & body] (apply-doc name doc? body)]
- `(defn ~name
- ~@doc?
- [& param-map#]
- (let [{:keys ~params} (apply hash-map param-map#)]
- ~@body))))
113 src/compojure/core.clj
View
@@ -0,0 +1,113 @@
+;; 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.core
+ "A concise syntax for generating Ring handlers."
+ (:use [ring.middleware params cookies]
+ clout.core
+ compojure.response))
+
+(defn- method-matches
+ "True if this request matches the supplied method."
+ [method request]
+ (let [request-method (request :request-method)
+ form-method (-> request :form-params :_method)]
+ (or (nil? method)
+ (if (and form-method (= request-method :post))
+ (= (.toUpperCase (name method)) form-method)
+ (= method request-method)))))
+
+(defn- prepare-route
+ "Pre-compile the route."
+ [route]
+ (cond
+ (string? route)
+ (route-compile route)
+ (seq? route)
+ (route-compile (first route) (apply hash-map (rest route)))
+ :else route))
+
+(defn- assoc-route-params
+ "Associate route parameters with the request map."
+ [request params]
+ (merge-with merge request {:route-params params, :params params}))
+
+(defn- param-vector-bindings
+ "Create the bindings for a vector of parameters."
+ [request bindings body]
+ (let [[args [_ more]] (split-with #(not= % '&) bindings)]
+ `(let [{:keys ~(vec args)} (~request :params)
+ ~@(if more [more `(dissoc (~request :params) ~@(map keyword args))])]
+ ~@body)))
+
+(defmacro bind-request
+ "Bind a request to a collection of symbols. The collection can be a Clojure
+ map destructuring binding for the request map, or it can be a vector of
+ parameter bindings."
+ [request bindings & body]
+ (if (vector? bindings)
+ (param-vector-bindings request bindings body)
+ `(let [~bindings ~request] ~@body)))
+
+(defn- compile-route
+ "Compile a route in the form (method path & body) into a function."
+ [method route bindings body]
+ `(let [route# ~(prepare-route route)]
+ (fn [request#]
+ (if (#'method-matches ~method request#)
+ (if-let [route-params# (route-matches route# request#)]
+ (let [request# (#'assoc-route-params request# route-params#)]
+ (bind-request request# ~bindings
+ (render (do ~@body)))))))))
+
+(defn routes
+ "Create a Ring handler by combining several handlers into one."
+ [& handlers]
+ (wrap-cookies
+ (wrap-params
+ (fn [request]
+ (some #(% request) handlers)))))
+
+(defn- apply-doc
+ "Return a symbol and body with an optional docstring applied."
+ [name doc? body]
+ (if (string? doc?)
+ (list* (vary-meta name assoc :doc doc?) body)
+ (list* name doc? body)))
+
+(defmacro defroutes
+ "Define a Ring handler function from a sequence of routes. Takes an optional
+ doc-string."
+ [name doc? & routes]
+ (let [[name & routes] (apply-doc name doc? routes)]
+ `(def ~name
+ (routes ~@routes))))
+
+(defmacro GET "Generate a GET route."
+ [path args & body]
+ (compile-route :get path args body))
+
+(defmacro POST "Generate a POST route."
+ [path args & body]
+ (compile-route :post path args body))
+
+(defmacro PUT "Generate a PUT route."
+ [path args & body]
+ (compile-route :put path args body))
+
+(defmacro DELETE "Generate a DELETE route."
+ [path args & body]
+ (compile-route :delete path args body))
+
+(defmacro HEAD "Generate a HEAD route."
+ [path args & body]
+ (compile-route :head path args body))
+
+(defmacro ANY "Generate a route that matches any method."
+ [path args & body]
+ (compile-route nil path args body))
129 src/compojure/crypto.clj
View
@@ -1,129 +0,0 @@
-;; 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.crypto
- "Functions for cryptographically signing, verifying and encrypting data."
- (:use compojure.encodings
- clojure.contrib.def
- clojure.contrib.java-utils)
- (:import java.security.SecureRandom
- [javax.crypto Cipher KeyGenerator Mac]
- [javax.crypto.spec SecretKeySpec IvParameterSpec]
- java.util.UUID))
-
-(defvar hmac-defaults
- {:algorithm "HmacSHA256"}
- "Default options for HMACs.")
-
-(defvar encrypt-defaults
- {:algorithm "AES"
- :key-size 128
- :mode "CBC"
- :padding "PKCS5Padding"}
- "Default options for symmetric encryption.")
-
-(defn secure-random-bytes
- "Returns a random byte array of the specified size. Can optionally supply
- an PRNG algorithm (defaults is SHA1PRNG)."
- ([size]
- (secure-random-bytes size "SHA1PRNG"))
- ([size algorithm]
- (let [seed (make-array Byte/TYPE size)]
- (.nextBytes (SecureRandom/getInstance algorithm) seed)
- seed)))
-
-(defn gen-secret-key
- "Generate a random secret key from a map of encryption options."
- ([]
- (gen-secret-key {}))
- ([options]
- (secure-random-bytes (/ (options :key-size) 8))))
-
-(defn gen-uuid
- "Generate a random UUID."
- []
- (str (UUID/randomUUID)))
-
-(defn- to-bytes
- "Converts its argument into an array of bytes."
- [x]
- (cond
- (string? x) (.getBytes x)
- (sequential? x) (into-array Byte/TYPE x)
- :else x))
-
-(defn hmac-bytes
- "Generate a HMAC byte array with the supplied key on a byte array of data.
- Takes an optional map of cryptography options."
- [options key data]
- (let [options (merge hmac-defaults options)
- algorithm (options :algorithm)
- hmac (doto (Mac/getInstance algorithm)
- (.init (SecretKeySpec. key algorithm)))]
- (.doFinal hmac data)))
-
-(defn hmac
- "Generate a Basc64-encoded HMAC with the supplied key on a byte array or
- string of data. Takes an optional map of cryptography options."
- [options key data]
- (base64-encode-bytes (hmac-bytes options key (to-bytes data))))
-
-(defn- make-algorithm
- "Return an algorithm string suitable for JCE from a map of options."
- [options]
- (str (options :algorithm) "/" (options :mode) "/" (options :padding)))
-
-(defn- make-cipher
- "Create an AES Cipher instance."
- [options]
- (Cipher/getInstance (make-algorithm options)))
-
-(defn encrypt-bytes
- "Encrypts a byte array with the given key and encryption options."
- [options key data]
- (let [options (merge encrypt-defaults options)
- cipher (make-cipher options)
- secret-key (SecretKeySpec. key (options :algorithm))
- iv (secure-random-bytes (.getBlockSize cipher))]
- (.init cipher Cipher/ENCRYPT_MODE secret-key (IvParameterSpec. iv))
- (to-bytes (concat iv (.doFinal cipher data)))))
-
-(defn decrypt-bytes
- "Decrypts a byte array with the given key and encryption options."
- [options key data]
- (let [options (merge encrypt-defaults options)
- cipher (make-cipher options)
- [iv data] (split-at (.getBlockSize cipher) data)
- iv-spec (IvParameterSpec. (to-bytes iv))
- secret-key (SecretKeySpec. key (options :algorithm))]
- (.init cipher Cipher/DECRYPT_MODE secret-key iv-spec)
- (.doFinal cipher (to-bytes data))))
-
-(defn encrypt
- "Encrypts a string or byte array with the given key and encryption options."
- [options key data]
- (base64-encode-bytes (encrypt-bytes options key (to-bytes data))))
-
-(defn decrypt
- "Base64 encodes and encrypts a string with the given key and algorithm."
- [options key data]
- (String. (decrypt-bytes options key (base64-decode-bytes data))))
-
-(defn seal
- "Seal a data structure into a cryptographically secure string. Ensures no-one
- looks at or tampers with the data inside."
- [key data]
- (let [data (encrypt {} key (marshal data))]
- (str data "--" (hmac {} key data))))
-
-(defn unseal
- "Read a cryptographically sealed data structure."
- [key data]
- (let [[data mac] (.split data "--")]
- (if (= mac (hmac {} key data))
- (unmarshal (decrypt {} key data)))))
64 src/compojure/encodings.clj
View
@@ -1,64 +0,0 @@
-;; 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.encodings
- "Functions for encoding data."
- (:use compojure.str-utils
- clojure.contrib.duck-streams)
- (:import [java.net URLEncoder URLDecoder]
- [org.apache.commons.codec.binary Base64 Hex]))
-
-(defn urlencode
- "Encode a urlencoded string using the default encoding."
- [s]
- (URLEncoder/encode (str* s) *default-encoding*))
-
-(defn urldecode
- "Decode a urlencoded string using the default encoding."
- [s]
- (URLDecoder/decode s *default-encoding*))
-
-(defn base64-encode-bytes
- "Encode an array of bytes into a base64 encoded string."
- [unencoded]
- (String. (Base64/encodeBase64 unencoded)))
-
-(defn base64-encode
- [unencoded]
- "Encode a string using base64."
- (base64-encode-bytes (.getBytes unencoded)))
-
-(defn base64-decode-bytes
- "Decode a string using base64 into an array of bytes."
- [encoded]
- (Base64/decodeBase64 (.getBytes encoded)))
-
-(defn base64-decode
- "Decode a string using base64."
- [encoded]
- (String. (base64-decode-bytes encoded)))
-
-(defn marshal
- "Serialize a Clojure object in a base64-encoded string."
- [data]
- (base64-encode (pr-str data)))
-
-(defn unmarshal
- "Unserialize a Clojure object from a base64-encoded string."
- [marshaled]
- (read-string (base64-decode marshaled)))
-
-(defn decode-hex
- "Converts a string of hex into it's corresponding byte array."
- [s]
- (Hex/decodeHex (.toCharArray s)))
-
-(defn encode-hex
- "Converts a byte array into it's corresponding hex String."
- [array]
- (String. (Hex/encodeHex array)))
16 src/compojure/html.clj
View
@@ -1,16 +0,0 @@
-;; 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.html
- "Shortcut to include all compojure.http.* namespaces."
- (:use compojure.ns-utils))
-
-(immigrate
- 'compojure.html.gen
- 'compojure.html.page-helpers
- 'compojure.html.form-helpers)
169 src/compojure/html/form_helpers.clj
View
@@ -1,169 +0,0 @@
-;; 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.html.form-helpers
- "Functions for generating HTML forms and input fields."
- (:use compojure.html.gen
- compojure.control
- compojure.str-utils
- clojure.contrib.def
- clojure.contrib.seq-utils))
-
-;; Global parameters for easy default values
-
-(defvar *params* {}
- "Parameter map var that form input field functions use to populate their
- default values.")
-
-(defmacro with-params
- "Bind a map of params to *params*."
- [params & body]
- `(binding [*params* ~params]
- ~@body))
-
-;; Form input fields
-
-(defn- input-field
- "Creates a form input field."
- [type name value]
- (let [name (str* name)
- attrs {:type type, :name name, :id name}
- attrs (if value
- (assoc attrs :value value)
- attrs)]
- [:input attrs]))
-
-(defn hidden-field
- "Creates a hidden input field."
- ([name] (hidden-field name (*params* name)))
- ([name value] (input-field "hidden" name value)))
-
-(defn text-field
- "Creates a text input field."
- ([name] (text-field name (*params* name)))
- ([name value] (input-field "text" name value)))
-
-(defn password-field
- "Creates a password input field."
- [name]
- (input-field "password" name ""))
-
-(defn check-box
- "Creates a check box."
- ([name]
- (check-box name (*params* name)))
- ([name checked?]
- (check-box name checked? "true"))
- ([name checked? value]
- [:input {:type "checkbox"
- :name (str* name)
- :id (str* name)
- :value value
- :checked checked?}]))
-
-(defn radio-button
- "Creates a radio button."
- ([group]
- (radio-button group (*params* group)))
- ([group checked?]
- (radio-button group checked? "true"))
- ([group checked? value]
- [:input {:type "radio"
- :name (str* group)
- :id (str* group "_" value)
- :value value
- :checked checked?}]))
-
-(defn select-options
- "Turn a collection into a set of option tags."
- ([options]
- (select-options options nil))
- ([options selected]
- (let [select (fn [opt attrs]
- (if (and selected (= opt (str* selected)))
- (merge attrs {:selected "selected"})
- attrs))]
- (domap [opt options]
- (if (vector? opt)
- (let [text (opt 0)
- value (str* (opt 1))]
- [:option (select value {:value value}) text])
- [:option (select opt {}) opt])))))
-
-(defn drop-down
- "Creates a drop-down box using the 'select' tag."
- ([name options]
- (drop-down name options (*params* name)))
- ([name options selected]
- [:select {:name (str* name) :id (str* name)}
- (select-options options selected)]))
-
-(defn text-area
- "Creates a text area element."
- ([name]
- (text-area name (*params* name)))
- ([name value]
- [:textarea {:name (str* name) :id (str* name)} value]))
-
-(defn file-upload
- "Creates a file upload input."
- [name]
- [:input {:type "file", :name (str* name), :id (str* name)}])
-
-(defn label
- "Create a label for an input field with the supplied name."
- [name text]
- [:label {:for (str* name)} text])
-
-(defn submit-button
- "Create a submit button."
- [text]
- [:input {:type "submit" :value text}])
-
-(defn reset-button
- "Create a form reset button."
- [text]
- [:input {:type "reset" :value text}])
-
-(defn form-to
- "Create a form that points to a particular method and route.
- e.g. (form-to [:put \"/post\"]
- ...)"
- [[method action] & body]
- (let [method-str (upcase-name method)]
- (into []
- (concat
- (if (includes? [:get :post] method)
- [:form {:method method-str :action action}]
- [:form {:method "POST" :action action}
- (hidden-field "_method" method-str)])
- body))))
-
-(decorate-with optional-attrs
- hidden-field
- text-field
- check-box
- drop-down
- text-area
- file-upload
- label
- submit-button
- reset-button
- form-to)
-
-(defmacro decorate-fields
- "Wrap all input field functions in a decorator."
- [decorator & body]
- `(decorate-bind ~decorator
- [text-field
- password-field
- check-box
- drop-down
- text-area
- file-upload]
- (list ~@body)))
124 src/compojure/html/gen.clj
View
@@ -1,124 +0,0 @@
-;; 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.html.gen
- "A library for generating HTML output from a tree of vectors. The first item
- of the vector is the tag name, the optional second item is a hash of
- attributes, and the rest is the body of the tag."
- (:use compojure.str-utils
- clojure.contrib.def))
-
-(defn optional-attrs
- "Adds an optional attribute map to the supplied function's arguments."
- [func]
- (fn [attrs & body]
- (if (map? attrs)
- (let [[tag func-attrs & body] (apply func body)]
- (apply vector tag (merge func-attrs attrs) body))
- (apply func attrs body))))
-
-(defn escape-html
- "Change special characters into HTML character entities."
- [string]
- (.. (str string)
- (replace "&" "&amp;")
- (replace "<" "&lt;")
- (replace ">" "&gt;")
- (replace "\"" "&quot;")))
-
-(defvar h escape-html
- "Shortcut for escape-html")
-
-(defn- map-to-attrs
- "Turn a map into a string of HTML attributes, sorted by attribute name."
- [attrs]
- (map-str
- (fn [[key val]]
- (if key
- (str " " key "=\"" (h val) "\"")))
- (sort
- (map (fn [[key val]]
- (cond
- (true? val) [(str* key) (str* key)]
- (not val) [nil nil]
- :else [(str* key) (str* val)]))
- attrs))))
-
-(defn- create-tag
- "Wrap some content in an HTML tag."
- [tag attrs content]
- (str* "<" tag (map-to-attrs attrs) ">"
- content
- "</" tag ">"))
-
-(defn- create-closed-tag
- "Make a closed XML tag with no content."
- [tag attrs]
- (str* "<" tag (map-to-attrs attrs) " />"))
-
-(defn- expand-seqs
- "Expand out all the sequences in a collection."
- [coll]
- (mapcat
- #(if (or (seq? %) (nil? %))
- %
- (list %))
- coll))
-
-(defn- ensure-attrs
- "Ensure the tag has a map of attributes."
- [[tag & body]]
- (if (map? (first body))
- (list* tag body)
- (list* tag {} body)))
-
-(defvar- css-lexer #"([^\s\.#]+)(?:#([^\s\.#]+))?(?:\.([^\s#]+))?")
-
-(defn- parse-css-tag
- "Pulls the id and class attributes from a tag name formatted in a CSS style.
- e.g. :div#content -> [:div {:id \"content\"}]
- :span.error -> [:span {:class \"error\"}]"
- [tag attrs]
- (let [[_ tag id classes] (re-matches css-lexer (str* tag))
- attrs (merge attrs
- (if id {:id id})
- (if classes
- {:class (.replace classes "." " ")}))]
- [tag attrs]))
-
-(declare html)
-
-(defvar- container-tags
- #{:a :b :body :dd :div :dl :dt :em :fieldset :form :h1 :h2 :h3 :h4 :h5 :h6
- :head :html :i :label :li :ol :pre :script :span :strong :style :textarea
- :ul}
- "A list of tags that need an explicit ending tag when rendered.")
-
-(defn explicit-ending-tag?
- "Returns true if tag needs an explicit ending tag, even if the body of the
- tag is empty."
- [tag]
- (container-tags (keyword (str* tag))))
-
-(defn html-tree
- "Turns a tree of vectors into a string of HTML. Any sequences in the
- tree are expanded out."
- [tree]
- (if (vector? tree)
- (let [[tag attrs & body] (ensure-attrs tree)
- [tag attrs] (parse-css-tag tag attrs)
- body (expand-seqs body)]
- (if (or (seq body) (explicit-ending-tag? tag))
- (create-tag tag attrs (apply html body))
- (create-closed-tag tag attrs)))
- (str tree)))
-
-(defn html
- "Format trees of vectors into a string of HTML."
- [& trees]
- (map-str html-tree (expand-seqs trees)))
103 src/compojure/html/page_helpers.clj
View
@@ -1,103 +0,0 @@
-;; 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.html.page-helpers
- "Functions for generating document and header boilerplate."
- (:use compojure.control
- compojure.html.gen
- compojure.str-utils
- clojure.contrib.str-utils)
- (:import java.net.URLEncoder))
-
-(def doctype
- {:html4
- (str "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01//EN\" "
- "\"http://www.w3.org/TR/html4/strict.dtd\">\n")
-
- :html5
- (str "<!DOCTYPE html>")
-
- :xhtml-strict
- (str "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" "
- "\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n")
-
- :xhtml-transitional
- (str "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\" "
- "\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">\n")})
-
-(defn xhtml-tag
- "Create an XHTML tag for the specified locale.
- e.g. (xhtml \"en\"
- [:head ...]
- [:body ...])"
- [lang & contents]
- [:html {:xmlns "http://www.w3.org/1999/xhtml"
- "xml:lang" lang
- :lang lang}
- contents])
-
-(defn include-js
- "Include a list of external javascript files."
- [& scripts]
- (domap [script scripts]
- [:script {:type "text/javascript" :src script}]))
-
-(defn include-css
- "Include a list of external stylesheet files."
- [& styles]
- (domap [style styles]
- [:link {:type "text/css" :href style :rel "stylesheet"}]))
-
-(defn javascript-tag
- "Wrap the supplied javascript up in script tags and a CDATA section."
- [script]
- [:script {:type "text/javascript"}
- (str "//<![CDATA[\n" script "\n//]]>")])
-
-(defn link-to
- "Wraps some content in a HTML hyperlink with the supplied URL."
- [url & content]
- [:a {:href url} content])
-
-(defn url-encode
- "Encodes a single string or sequence of key/value pairs."
- [string-or-map]
- (let [enc #(URLEncoder/encode (str* %))]
- (if (string? string-or-map)
- (enc string-or-map)
- (str-join "&"
- (map (fn [[key val]] (str (enc key) "=" (enc val)))
- string-or-map)))))
-
-(defn url-params
- "Encodes a map of parameters and adds them onto the end of an existing
- address.
- e.g. (url-params \"http://example.com\" {:lang \"en\", :offset 10})
- => \"http://example.com?lang=en&offset=10\""
- [address param-map]
- (str address "?" (url-encode param-map)))
-
-(defn unordered-list
- "Wrap a collection in an unordered list"
- [coll]
- [:ul {}
- (domap [x coll]
- [:li x])])
-
-(defn ordered-list
- "Wrap a collection in an unordered list"
- [coll]
- [:ol {}
- (domap [x coll]
- [:li x])])
-
-(decorate-with optional-attrs
- xhtml-tag
- link-to
- unordered-list
- ordered-list)
19 src/compojure/http.clj
View
@@ -1,19 +0,0 @@
-;; 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
- "Shortcut to include compojure.http.routes, compojure.http.helpers and
- compojure.http.servlet."
- (:use compojure.ns-utils))
-
-(immigrate
- 'compojure.http.helpers
- 'compojure.http.middleware
- 'compojure.http.multipart
- 'compojure.http.routes
- 'compojure.http.servlet)
76 src/compojure/http/helpers.clj
View
@@ -1,76 +0,0 @@
-;; 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.helpers
- "Helper functions for things like redirection, serving files, 404s, etc."
- (:use compojure.encodings
- compojure.str-utils
- clojure.contrib.def
- clojure.contrib.str-utils
- clojure.contrib.duck-streams)
- (:import java.io.File))
-
-(defn- encode-cookie
- "Encode sequence of key/value pairs a cookie."
- [name value attrs]
- (str-join "; "
- (cons (str (urlencode name) "=" (urlencode value))
- (for [[key val] attrs] (str* key "=" val)))))
-
-(defn set-cookie
- "Return a Set-Cookie header."
- ([name value]
- {:headers {"Set-Cookie" (encode-cookie name value nil)}})
- ([name value & attrs]
- {:headers {"Set-Cookie" (encode-cookie name value (partition 2 attrs))}}))
-
-(defn content-type
- "Retuns a Content-Type header given a type string."
- [type]
- {:headers {"Content-Type" type}})
-
-(defn redirect-to
- "A shortcut for a '302 Moved' HTTP redirect."
- [location]
- [302 {:headers {"Location" location}}])
-
-(defn page-not-found
- "A shortcut to create a '404 Not Found' HTTP response."
- ([]
- (page-not-found "public/404.html"))
- ([filename]
- [404 (File. filename)]))
-
-(defn- find-index-file
- "Search the directory for index.*"
- [dir]
- (first
- (filter
- #(.startsWith (.toLowerCase (.getName %)) "index.")
- (.listFiles dir))))
-
-(defn safe-path?
- "Is a filepath safe for a particular root?"
- [root path]
- (.startsWith (.getCanonicalPath (File. root path))
- (.getCanonicalPath (File. root))))
-
-(defn serve-file
- "Attempts to serve up a static file from a directory, which defaults to
- './public'. Nil is returned if the file does not exist. If the file is a
- directory, the function looks for a file in the directory called 'index.*'."
- ([path]
- (serve-file "public" path))
- ([root path]
- (let [filepath (File. root path)]
- (if (safe-path? root path)
- (cond
- (.isFile filepath)
- filepath
- (.isDirectory filepath)
- (find-index-file filepath))))))
131 src/compojure/http/middleware.clj
View
@@ -1,131 +0,0 @@
-;; 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.middleware
- "Various middleware functions."
- (:use compojure.http.routes
- compojure.str-utils
- clojure.contrib.def
- clojure.contrib.str-utils))
-
-(defn header-option
- "Converts a header option KeyValue into a string."
- [[key val]]
- (cond
- (true? val) (str* key)
- (false? val) nil
- :otherwise (str* key "=" val)))
-
-(defn header-options
- "Converts a map into an HTTP header options string."
- [m delimiter]
- (str-join delimiter
- (remove nil? (map header-option m))))
-
-(defn with-headers
- "Merges a map of header name and values into the response. Overwrites
- existing headers."
- [handler headers]
- (fn [request]
- (if-let [response (handler request)]
- (assoc response :headers
- (merge (:headers response) headers)))))
-
-(defn with-cache-control
- "Middleware to set the Cache-Control http header. Map entries with boolean
- values either write their key if true, or nothing if false.
- Example:
- {:max-age 3600 :public false :must-revalidate true}
- => Cache-Control: max-age=3600, must-revalidate"
- [handler header-map]
- (with-headers handler
- {"Cache-Control" (header-options header-map ", ")}))
-
-(defn with-uri-rewrite
- "Rewrites a request uri with the result of calling f with the
- request's original uri. If f returns nil the handler is not called."
- [handler f]
- (fn [request]
- (let [uri (:uri request)
- rewrite (f uri)]
- (if rewrite
- (handler (assoc request :uri rewrite))
- nil))))
-
-(defn- remove-or-nil-context
- "Removes a context string from the front of a uri. If it wasn't there,
- returns nil."
- [uri context]
- (if (.startsWith uri context)
- (if-not (= uri context)
- (subs uri (count context))
- "/")
- nil))
-
-(defn with-context
- "Removes the context string from the beginning of the request uri
- such that route matching is done without it. If the context is not
- present, the handler will not be called."
- [handler context]
- (with-uri-rewrite handler #(remove-or-nil-context % context)))
-
-(defn- uri-snip-slash
- "Removes a trailing slash from all uris except \"/\"."
- [uri]
- (if (and (not (= "/" uri))
- (.endsWith uri "/"))
- (chop uri)
- uri))
-
-(defn ignore-trailing-slash
- "Makes routes match regardless of whether or not a uri ends in a slash."
- [handler]
- (with-uri-rewrite handler uri-snip-slash))
-
-(defvar default-mimetypes
- {"css" "text/css"
- "gif" "image/gif"
- "gz" "application/gzip"
- "htm" "text/html"
- "html" "text/html"
- "jpg" "image/jpeg"
- "js" "text/javascript"
- "pdf" "application/pdf"
- "png" "image/png"
- "swf" "application/x-shockwave-flash"
- "txt" "text/plain"
- "xml" "text/xml"
- "zip" "application/zip"}
- "Default mimetype map used by with-mimetypes.")
-
-(defn- extension
- "Returns the text after the last . of a String or nil."
- [s]
- (last (re-split #"\." s)))
-
-(defn- request-mimetype
- "Derives the mimetype from a request. See with-mimetypes for options."
- [request options]
- (let [default (or (:default options) "text/html")]
- (if-let [ext (extension (:uri request))]
- (let [mimetypes (or (:mimetypes options) default-mimetypes)]
- (get mimetypes ext default))
- default)))
-
-(defn with-mimetypes
- "Middleware to add the proper Content-Type header based on the uri of
- the request. options is a map containing a :mimetype map of extension
- to type and a :default mime type. If :mimetype is not provided, a default
- map with common mime types will be used. If :default is not provided,
- \"text/html\" is used."
- ([handler]
- (with-mimetypes handler {}))
- ([handler options]
- (fn [request]
- (let [mimetype (request-mimetype request options)]
- ((with-headers handler {"Content-Type" mimetype}) request)))))
80 src/compojure/http/multipart.clj
View
@@ -1,80 +0,0 @@
-;; 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.multipart
- "Add multipart form handling to Compojure. Relies on the Apache Commons
- FileUpload library."
- (:use clojure.contrib.def
- compojure.map-utils)
- (:import [org.apache.commons.fileupload FileUpload RequestContext]
- [org.apache.commons.fileupload.disk DiskFileItemFactory DiskFileItem]))
-
-(defn multipart-form?
- "Does a request have a multipart form?"
- [request]
- (if-let [content-type (:content-type request)]
- (.startsWith content-type "multipart/form-data")))
-
-(defvar- file-upload
- (FileUpload.
- (doto (DiskFileItemFactory.)
- (.setSizeThreshold -1)
- (.setFileCleaningTracker nil)))
- "Uploader class to save multipart form values to temporary files.")
-
-(defn- request-context
- "Create a RequestContext object from a request map."
- [request]
- (proxy [RequestContext] []
- (getContentType [] (:content-type request))
- (getContentLength [] (:content-length request))
- (getCharacterEncoding [] (:character-encoding request))
- (getInputStream [] (:body request))))
-
-(defn- file-map
- "Create a file map from a DiskFileItem."
- [#^DiskFileItem item]
- {:disk-file-item item
- :filename (.getName item)
- :size (.getSize item)
- :content-type (.getContentType item)
- :tempfile (.getStoreLocation item)})
-
-(defn parse-multipart-params
- "Parse a map of multipart parameters from the request."
- [request]
- (reduce
- (fn [param-map, #^DiskFileItem item]
- (assoc-vec param-map
- (keyword (.getFieldName item))
- (if (.isFormField item)
- (if (zero? (.getSize item))
- ""
- (.getString item))
- (file-map item))))
- {}
- (.parseRequest
- file-upload
- (request-context request))))
-
-(defn get-multipart-params
- "Retrieve multipart params from the request."
- [request]
- (if (multipart-form? request)
- (parse-multipart-params request)
- {}))
-
-(defn with-multipart
- "Decorate a Ring handler with multipart parameters."
- [handler]
- (fn [request]
- (let [params (get-multipart-params request)
- request (-> request
- (assoc :multipart-params params)
- (assoc :params (merge (request :params) params)))]
- (handler request))))
109 src/compojure/http/request.clj
View
@@ -1,109 +0,0 @@
-;; 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.request
- "Functions for pulling useful data out of a HTTP request map."
- (:use compojure.control
- compojure.encodings
- compojure.map-utils
- compojure.str-utils
- clojure.contrib.duck-streams
- clojure.contrib.str-utils)
- (:import java.net.URLDecoder
- java.io.InputStreamReader))
-
-(defn- parse-params
- "Parse parameters from a string into a map."
- [param-string separator]
- (reduce
- (fn [param-map s]
- (if-let [[_ key val] (re-matches #"([^=]+)=(.*)" s)]
- (assoc-vec param-map
- (keyword (urldecode key))
- (urldecode (or val "")))
- param-map))
- {}
- (remove blank?
- (re-split separator param-string))))
-
-(defn parse-query-params
- "Parse parameters from the query string."
- [request]
- (if-let [query (request :query-string)]
- (parse-params query #"&")))
-
-(defn get-character-encoding
- "Get the character encoding, or use the default from duck-streams."
- [request]
- (or (request :character-encoding) *default-encoding*))
-
-(defn- slurp-body
- "Slurp the request body into a string."
- [request]
- (let [encoding (get-character-encoding request)]
- (if-let [body (request :body)]
- (slurp* (InputStreamReader. body encoding)))))
-
-(defn urlencoded-form?
- "Does a request have a urlencoded form?"
- [request]
- (if-let [type (:content-type request)]
- (.startsWith type "application/x-www-form-urlencoded")))
-
-(defn parse-form-params
- "Parse urlencoded form parameters from the request body."
- [request]
- (if (urlencoded-form? request)
- (if-let [body (slurp-body request)]
- (parse-params body #"&"))))
-
-(defn- get-merged-params
- "Get a map of all the parameters merged together."
- [request]
- (merge (:query-params request)
- (:form-params request)
- (:params request)))
-
-(defn- assoc-func
- "Associate the result of a (func request) with a key on the request map."
- [request key func]
- (if (contains? request key)
- request
- (assoc request key (or (func request) {}))))
-
-(defn assoc-params
- "Associate urlencoded parameters with a request. The following keys are added
- to the request map: :query-params, :form-params and :params."
- [request]
- (-> request
- (assoc-func :query-params parse-query-params)
- (assoc-func :form-params parse-form-params)
- (assoc-func :params get-merged-params)))
-
-(defn with-request-params
- "Decorator that adds urlencoded parameters to the request map."
- [handler]
- (fn [request]
- (handler (assoc-params request))))
-
-(defn parse-cookies
- "Pull out a map of cookies from a request map."
- [request]
- (if-let [cookies (get-in request [:headers "cookie"])]
- (parse-params cookies #";\s*")))
-
-(defn assoc-cookies
- "Associate cookies with a request map."
- [request]
- (assoc-func request :cookies parse-cookies))
-
-(defn with-cookies
- "Decorator that adds cookies to a request map."
- [handler]
- (fn [request]
- (handler (assoc-cookies request))))
106 src/compojure/http/response.clj
View
@@ -1,106 +0,0 @@
-;; 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.response
- "Parse a Compojure route return value into a HTTP response map."
- (:use clojure.contrib.def
- compojure.http.helpers)
- (:import clojure.lang.Fn
- clojure.lang.IPersistentVector
- java.util.Map
- clojure.lang.ISeq
- java.io.File
- java.io.InputStream
- java.net.URL
- clojure.lang.Keyword))
-
-(defmulti update-response
- "Update a response with an object. The type of object determines how the
- response is updated."
- (fn [request reponse update]
- (class update)))
-
-(defmethod update-response Integer
- [request response status]
- (assoc response :status status))
-
-(defmethod update-response String
- [request response body]
- (let [headers (merge (:headers (content-type "text/html")) (:headers response))
- response (assoc response :headers headers)]
- (if (string? (:body response))
- (merge-with str response {:body body})
- (assoc response :body body))))
-
-(defmethod update-response ISeq
- [request response sequence]
- (assoc response :body sequence))
-
-(defmethod update-response File
- [request response file]
- (assoc response :body file))
-
-(defmethod update-response InputStream
- [request response stream]
- (assoc response :body stream))
-
-(defmethod update-response URL
- [request response url]
- (assoc response :body (.openStream url)))
-
-(defmethod update-response IPersistentVector
- [request response updates]
- (reduce (partial update-response request) response updates))
-
-(defmethod update-response Keyword
- [request response kw]
- (if (not= kw :next)
- (update-response request response (str kw))))
-
-(defmethod update-response Fn
- [request response func]
- (update-response request response (func request)))
-
-(defmethod update-response nil
- [request response _]
- response)
-
-(defn- merge-map
- "Merges an inner map in 'from' into 'to'"
- [to key from]
- (merge-with merge to (select-keys from [key])))
-
-(defn- merge-bodies
- "Merge the bodies in 'from' into 'to'."
- [to from]
- (let [from (select-keys from [:body])]
- (if (and (-> to :body string?) (-> from :body string?))
- (merge-with str to from)
- (merge to from))))
-
-(defn- merge-rest
- "Merge everything but the headers, session and body."
- [to from]
- (merge to (dissoc from :headers :session :body)))
-
-(defmethod update-response Map
- [request response update-map]
- (-> response
- (merge-map :headers update-map)
- (merge-map :session update-map)
- (merge-bodies update-map)
- (merge-rest update-map)))
-
-(defvar default-response
- {:status 200, :headers {}}
- "Default HTTP response map.")
-
-(defn create-response
- "Create a new response map from an update object, x."
- [request x]
- (update-response request default-response x))
243 src/compojure/http/routes.clj
View
@@ -1,243 +0,0 @@
-;; 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.routes
- "Macros and functions for compiling routes in the form (method path & body)
- into stand-alone functions that return the return value of the body, or the
- keyword :next if they don't match."
- (:use compojure.http.request
- compojure.http.response
- compojure.http.session
- compojure.str-utils
- compojure.map-utils
- compojure.control
- compojure.encodings)
- (:import java.util.regex.Pattern
- java.util.Map))
-
-;; Functions for lexing a string
-
-(defn- lex-1
- "Lex one symbol from a string, and return the symbol and trailing source."
- [src clauses]
- (some
- (fn [[re action]]
- (let [matcher (re-matcher re src)]
- (if (.lookingAt matcher)
- [(if (fn? action) (action matcher) action)
- (.substring src (.end matcher))])))
- (partition 2 clauses)))
-
-(defn- lex
- "Lex a string into tokens by matching against regexs and evaluating
- the matching associated function."
- [src & clauses]
- (loop [results []
- src src
- clauses clauses]
- (if-let [[result src] (lex-1 src clauses)]
- (let [results (conj results result)]
- (if (= src "")
- results
- (recur results src clauses))))))
-
-;; Functions for matching URIs using a syntax borrowed from Ruby frameworks
-;; like Sinatra and Rails.
-
-(defstruct uri-matcher
- :regex
- :keywords)
-
-(defn compile-uri-matcher
- "Compile a path string using the routes syntax into a uri-matcher struct."
- [path]
- (let [splat #"\*"
- word #":([A-Za-z][\w-]*)"
- literal #"(:[^A-Za-z*]|[^:*])+"]
- (struct uri-matcher
- (re-pattern
- (apply str
- (lex path
- splat "(.*?)"
- word "([^/.,;?]+)"
- literal #(re-escape (.group %)))))
- (vec
- (remove nil?
- (lex path
- splat :*
- word #(keyword (.group % 1))
- literal nil))))))
-
-;; Don't compile paths more than once.
-(decorate-with memoize compile-uri-matcher)
-
-(defmulti compile-matcher
- "Compile a string or regex into a form suitable for buing passed to the
- match-uri function."
- class)
-
-(defmethod compile-matcher String
- [path]
- (compile-uri-matcher path))
-
-(defmethod compile-matcher Pattern
- [re]
- re)
-
-(defn- assoc-keywords-with-groups
- "Create a hash-map from a series of regex match groups and a collection of
- keywords."
- [groups keywords]
- (reduce
- (fn [m [k v]] (assoc-vec m k v))
- {}
- (map vector keywords groups)))
-
-(defmulti match-uri
- "Match a URL against a compiled URI-matcher or a regular expression. Returns
- the matched URI keywords as a map, or the matched regex groups as a vector."
- (fn [matcher uri] (class matcher)))
-
-(defmethod match-uri Map
- [uri-matcher uri]
- (let [matcher (re-matcher (uri-matcher :regex) (or uri "/"))]
- (if (.matches matcher)
- (assoc-keywords-with-groups
- (map urldecode (re-groups* matcher))
- (uri-matcher :keywords)))))
-
-(defmethod match-uri Pattern
- [uri-pattern uri]
- (let [matches (re-matches uri-pattern (or uri "/"))]
- (if matches
- (if (vector? matches)
- (vec (map urldecode (rest matches)))
- []))))
-
-(defn match-method
- "True if this request matches the supplied method."
- [method request]
- (let [request-method (request :request-method)
- form-method (-> request :form-params :_method)]
- (or (nil? method)
- (if (and form-method (= request-method :post))
- (= (upcase-name method) form-method)
- (= method request-method)))))
-
-(defn request-url
- "Return the complete URL for the request."
- [request]
- (str
- (name (:scheme request))
- "://"
- (get-in request [:headers "host"])
- (:uri request)))
-
-(defn absolute-url?
- "True if the string is an absolute URL."
- [s]
- (re-find #"^[a-z+.-]+://" s))
-
-(defn get-matcher-uri
- "Get the appropriate request URI for the given path pattern."
- [path request]
- (if (and (string? path) (absolute-url? path))
- (request-url request)
- (:uri request)))
-
-(defmacro request-matcher
- "Compiles a function to match a HTTP request against the supplied method
- and path template. Returns a map of the route parameters if the is a match,
- nil otherwise. Precompiles the route when supplied with a literal string."
- [method path]
- (let [matcher (if (or (string? path) (instance? Pattern path))
- (compile-matcher path)
- `(compile-matcher ~path))]
- `(fn [request#]
- (and
- (match-method ~method request#)
- (match-uri ~matcher (get-matcher-uri ~path request#))))))
-
-;; Functions and macros for generating routing functions. A routing function
-;; returns :next if it doesn't match, and any other value if it does.
-
-(defmacro with-request-bindings
- "Add shortcut bindings for the keys in a request map."
- [request & body]
- `(let [~'request ~request
- ~'params (:params ~'request)
- ~'cookies (:cookies ~'request)
- ~'session (:session ~'request)
- ~'flash (:flash ~'request)]
- ~@body))
-
-(defn assoc-route-params
- "Associate route parameters with the request map."
- [request params]
- (-> request
- (assoc :route-params params)
- (assoc :params (merge (:params request)
- (if (map? params) params)))))
-
-(defn compile-route
- "Compile a route in the form (method path & body) into a function."
- [method path body]
- `(let [matcher# (request-matcher ~method ~path)]
- (fn [request#]
- (if-let [route-params# (matcher# request#)]
- (let [request# (assoc-route-params request# route-params#)]
- (create-response request#
- (with-request-bindings request# ~@body)))))))
-
-(defn routes*
- "Create a Ring handler by combining several handlers into one."
- [& handlers]
- (fn [request]
- (some #(% request) handlers)))
-
-(defn routes
- "Create a Ring handler by combining several routes into one. Adds parameters
- and cookies to the request."
- [& handlers]
- (-> (apply routes* handlers)
- with-request-params
- with-cookies))
-
-;; Macros for easily creating a compiled routing table
-
-(defmacro defroutes
- "Define a Ring handler function from a sequence of routes. Takes an optional
- doc-string."
- [name doc? & routes]
- (let [[name & routes] (apply-doc name doc? routes)]
- `(def ~name
- (routes ~@routes))))
-
-(defmacro GET "Generate a GET route."
- [path & body]
- (compile-route :get path body))
-
-(defmacro POST "Generate a POST route."
- [path & body]
- (compile-route :post path body))
-
-(defmacro PUT "Generate a PUT route."
- [path & body]
- (compile-route :put path body))
-
-(defmacro DELETE "Generate a DELETE route."
- [path & body]
- (compile-route :delete path body))
-
-(defmacro HEAD "Generate a HEAD route."
- [path & body]
- (compile-route :head path body))
-
-(defmacro ANY "Generate a route that matches any method."
- [path & body]
- (compile-route nil path body))
129 src/compojure/http/servlet.clj
View
@@ -1,129 +0,0 @@
-;; 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))))
243 src/compojure/http/session.clj
View
@@ -1,243 +0,0 @@
-;; 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.session
- "Functions for creating and updating HTTP sessions."
- (:use compojure.str-utils
- compojure.http.helpers
- compojure.http.request
- compojure.http.response
- compojure.encodings
- compojure.crypto
- clojure.contrib.except))
-
-;; Override these mulitmethods to create your own session storage.
-;; Uses the Compojure repository pattern.
-
-(defmulti create-session
- "Create a new session map. Should not attempt to save the session."
- (fn [repository] (:type repository)))
-
-(defmulti read-session
- "Read in the session using the supplied data. Usually the data is a key used
- to find the session in a store."
- (fn [repository data] (:type repository)))
-
-(defmulti write-session
- "Write a new or existing session to the session store."
- (fn [repository session] (:type repository)))
-
-(defmulti destroy-session
- "Remove the session from the session store."
- (fn [repository session] (:type repository)))
-
-(defmulti session-cookie
- "Return the session data to be stored in the cookie. This is usually the
- session ID."
- (fn [repository new? session] (:type repository)))
-
-;; Default implementations of create-session and set-session-cookie
-
-(defmethod create-session :default
- [repository]
- {:id (gen-uuid)})
-
-(defmethod session-cookie :default
- [repository new? session]
- (if new?
- (session :id)))
-
-;; In memory sessions
-
-(def memory-sessions (ref {}))
-
-(defmethod read-session :memory
- [repository id]
- (@memory-sessions id))
-
-(defmethod write-session :memory
- [repository session]
- (dosync
- (alter memory-sessions
- assoc (session :id) session)))
-
-(defmethod destroy-session :memory
- [repository session]
- (dosync
- (alter memory-sessions
- dissoc (session :id))))
-
-;; Cookie sessions
-
-(def default-session-key
- (delay (gen-secret-key {:key-size 128})))
-
-(defn- get-session-key
- "Get the session key from the repository or use the default key."
- [repository]
- (force (repository :session-key default-session-key)))
-
-(defmethod create-session :cookie
- [repository]
- {})
-
-(defmethod session-cookie :cookie
- [repository new? session]
- (let [session-key (get-session-key repository)
- cookie-data (seal session-key session)]
- (if (> (count cookie-data) 4000)
- (throwf "Session data exceeds 4K")
- cookie-data)))
-
-(defmethod read-session :cookie
- [repository data]
- (unseal (get-session-key repository) data))
-
-(defmethod write-session :cookie
- [repository session])
-
-(defmethod destroy-session :cookie
- [repository session])
-
-;; Session middleware
-
-(defn timestamp-after
- "Return the current time plus seconds as milliseconds."
- [seconds]
- (+ (* seconds 1000) (System/currentTimeMillis)))
-
-(defn assoc-expiry
- "Associate an :expires-at key with the session if the session repository
- contains the :expires key."
- [repository session]
- (if-let [expires (:expires repository)]
- (assoc session :expires-at (timestamp-after expires))
- session))
-
-(defn session-expired?
- "True if this session's timestamp is in the past."
- [session]
- (if-let [expires-at (:expires-at session)]
- (< expires-at (System/currentTimeMillis))))
-
-(defn- get-session
- "Retrieve the session using the 'session' cookie in the request."
- [repository request]
- (if-let [session-data (-> request :cookies :compojure-session)]
- (read-session repository session-data)))
-
-(defn- assoc-new-session
- "Associate a new session with a request."
- [repository request]
- (assoc request
- :session (assoc-expiry repository (create-session repository))
- :new-session? true))
-
-(defn assoc-session
- "Associate the session with the request."
- [request repository]
- (if-let [session (get-session repository request)]
- (if (session-expired? session)
- (do
- (destroy-session repository session)
- (assoc-new-session repository request))
- (assoc request :session
- (assoc-expiry repository session)))
- (assoc-new-session repository request)))
-
-(defn assoc-flash
- "Associate the session flash with the request and remove it from the
- session."
- [request]
- (let [session (:session request)]
- (-> request
- (assoc :flash (session :flash {}))
- (assoc :session (dissoc session :flash)))))
-
-(defn set-session-cookie
- "Set the session cookie on the response if required."
- [repository request response session]
- (let [new? (:new-session? request)
- cookie (session-cookie repository new? session)
- update (set-cookie :compojure-session cookie
- :path (repository :path "/"))]
- (if cookie
- (update-response request response update)
- response)))
-
-(defn save-handler-session
- "Save the session for a handler if required."
- [repository request response session]
- (when (and (contains? response :session)
- (nil? (response :session)))
- (destroy-session repository session))
- (when (or (:session response)
- (:new-session? request)
- (not-empty (:flash request))
- (contains? repository :expires))
- (write-session repository session)))
-
-(defn- keyword->repository
- "If the argument is a keyword, expand it into a repository map."
- [repository]
- (if (keyword? repository)
- {:type repository}
- repository))
-
-(defn with-session
- "Wrap a handler in a session of the specified type. Session type defaults to
- :memory if not supplied."
- ([handler]
- (with-session handler :memory))
- ([handler repository]
- (fn [request]
- (let [repo (keyword->repository repository)
- request (-> request (assoc-cookies)
- (assoc-session repo)
- (assoc-flash))
- response (handler request)
- session (if (contains? response :session)
- (:session response)
- (:session request))]
- (when response
- (save-handler-session repo request response session)
- (set-session-cookie repo request response session))))))
-
-;; Useful functions for modifying the session
-
-(defn set-session
- "Return a response map with the session set."
- [session]
- {:session session})
-
-(defn clear-session
- "Set the session to nil."
- []
- (set-session nil))
-
-(defn alter-session
- "Use a function to alter the session."
- [func & args]
- (fn [request]
- (set-session
- (apply func (request :session) args))))
-
-(defn session-assoc
- "Associate key value pairs with the session."
- [& keyvals]
- (apply alter-session assoc keyvals))
-
-(defn session-dissoc
- "Dissociate keys from the session."
- [& keys]
- (apply alter-session dissoc keys))
-
-(defn flash-assoc
- "Associate key value pairs with the session flash."
- [& keyvals]
- (alter-session merge {:flash (apply hash-map keyvals)}))
21 src/compojure/map_utils.clj
View
@@ -1,21 +0,0 @@
-;; 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.map-utils
- "functions for manipulating maps.")
-
-(defn assoc-vec
- "Associate a key with a value. If the key already exists in the map, create a
- vector of values."
- [map key val]
- (assoc map key
- (if-let [cur (map key)]
- (if (vector? cur)
- (conj cur val)
- [cur val])
- val)))
23 src/compojure/ns_utils.clj
View
@@ -1,23 +0,0 @@
-;; 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.ns-utils)
-
-(defn immigrate
- "Create a public var in this namespace for each public var in the
- namespaces named by ns-names. The created vars have the same name, value,
- and metadata as the original except that their :ns metadata value is this
- namespace."
- [& ns-names]
- (doseq [ns ns-names]
- (require ns)
- (doseq [[sym var] (ns-publics ns)]
- (let [sym (with-meta sym (assoc (meta var) :ns *ns*))]
- (if (.isBound var)
- (intern *ns* sym (var-get var))
- (intern *ns* sym))))))
26 src/compojure/validation/predicates.clj → src/compojure/response.clj
View
@@ -6,15 +6,21 @@
;; terms of this license. You must not remove this notice, or any other, from
;; this software.
-(ns compojure.validation.predicates
- (:use compojure.str-utils))
+(ns compojure.response
+ "Methods for generating Ring response maps"
+ (:import java.util.Map))
-(defn present?
- "True if x is not nil and not an empty string."
- [x]
- (not (blank? x)))
+(defmulti render
+ "Turns its argument into an appropriate response"
+ type)
-(defn max-size
- "Returns a function to check a maximum size of a collection."
- [n]
- #(<= (count %) n))
+(defmethod render nil [_] nil)
+
+(defmethod render String [html-string]
+ {:status 200
+ :headers {"Content-Type" "text/html"}
+ :body html-string})
+
+(defmethod render Map [a-map]
+ (merge {:status 200, :headers {}, :body ""}
+ a-map))
26 src/compojure/server/common.clj
View
@@ -1,26 +0,0 @@
-;; 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.server.common
- "Common functions for implementing compojure server wrapper."
- (:import java.net.URL))
-
-(defn get-host-and-path
- "Splits a path or URL into its hostname and path."
- [url-or-path]
- (if (re-find #"^[a-z+.-]+://" url-or-path)
- (let [url (URL. url-or-path)]
- [(.getHost url) (.getPath url)])
- [nil url-or-path]))
-
-(defn server-with-options
- "Create a new server using the supplied function, options and servlets."
- [creator options servlets]
- (if (map? options)
- (creator options servlets)
- (creator {} (cons options servlets))))
74 src/compojure/server/grizzly.clj
View
@@ -1,74 +0,0 @@
-;; 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.server.grizzly
- "Clojure interface to start an embedded Grizzly server. To compile, use:
- ant -Dwith.grizzly"
- (:use compojure.control
- compojure.server.common)
- (:import javax.servlet.Servlet
- com.sun.grizzly.http.embed.GrizzlyWebServer
- com.sun.grizzly.http.servlet.ServletAdapter))
-
-(defn #^ServletAdapter servlet-adapter
- "Wrap a servlet in a ServletAdapter object with a supplied set of parameters
- to be set on servlet init."
- [#^Servlet servlet & params]
- (let [adapter (new ServletAdapter servlet)
- params (partition 2 params)]
- (doseq [[key val] params]
- (.addInitParameter adapter (name key) (str val)))
- adapter))
-
-(defn add-servlet!
- "Add a servlet to a Grizzly server. Servlets can be connected to a relative
- path or an absolute URL. Unlike the Jetty server, no Virtual Hosts
- are setup."
- [#^GrizzlyWebServer server url-or-path servlet]
- (let [[host path] (get-host-and-path url-or-path)
- #^ServletAdapter adapter (if (instance? ServletAdapter servlet)
- servlet
- ;; Otherwise, assume it's a servlet.
- (let [#^Servlet ss (cast Servlet servlet)]
- (ServletAdapter. ss)))]
- (.addGrizzlyAdapter server adapter (into-array [path]))))
-
-(defn- #^GrizzlyWebServer create-server
- "Construct a Grizzly Server instance."
- [options servlets]
- (let [port (options :port 80)
- server (GrizzlyWebServer. (int port))
- servlets (partition 2 servlets)]
- (doseq [[url-or-path servlet] servlets]
- (add-servlet! server url-or-path servlet))
- server))
-
-(defn #^GrizzlyWebServer grizzly-server
- "Create a new Grizzly HTTP server with the supplied options and servlets."
- [options & servlets]
- (server-with-options create-server options servlets))
-
-(defmacro defserver
- "Shortcut for (def name (http-server args))"
- [name & args]
- `(def ~name (grizzly-server ~@args)))
-
-(defn start "Start a HTTP server."
- [#^GrizzlyWebServer server]
- (.start server))
-
-(defn stop "Stop a HTTP server."
- [#^GrizzlyWebServer server]
- (.stop server))
-
-(defn run-server
- "Create and start a new Grizzly HTTP server."
- [& server-args]
- (let [#^GrizzlyWebServer server (apply grizzly-server server-args)]
- (.start server)
- server))
106 src/compojure/server/jetty.clj
View
@@ -1,106 +0,0 @@
-;; 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.server.jetty
- "Clojure interface to start an embedded Jetty server."
- (:use compojure.control
- compojure.server.common)
- (:import org.mortbay.jetty.Server
- [org.mortbay.jetty.servlet Context ServletHolder]
- org.mortbay.jetty.bio.SocketConnector
- org.mortbay.jetty.security.SslSocketConnector))
-
-(defn servlet-holder
- "Wrap a servlet in a ServletHolder object with a supplied set of parameters
- to be set on servlet init."
- [servlet & params]
- (let [holder (new ServletHolder servlet)
- params (partition 2 params)]
- (doseq [[key val] params]
- (.setInitParameter holder (name key) (str val)))
- holder))
-
-(defn get-context
- "Get a Context instance for a server and hostname."
- ([server]
- (get-context server nil))
- ([server host]
- (let [context (Context. server "/" Context/SESSIONS)]
- (if host
- (doto context (.setVirtualHosts (into-array [host])))
- context))))
-
-(decorate-with memoize get-context)
-
-(defn add-servlet!
- "Add a servlet to a Jetty server. Servlets can be connected to a relative
- path or an absolute URL. When connected to a URL, the function will try and
- use the hostname to set up a virtual host. Wildcards for the domain and path
- are allowed."
- [server url-or-path servlet]
- (prn (class servlet))
- (let [[host path] (get-host-and-path url-or-path)
- context (get-context server host)
- holder (if (instance? ServletHolder servlet)
- servlet
- (ServletHolder. servlet))]
- (.addServlet context holder path)))
-
-(defn- add-ssl-connector!
- "Add an SslSocketConnector to a Jetty server."
- [server options]
- (let [ssl-connector (SslSocketConnector.)]
- (doto ssl-connector
- (.setPort (options :ssl-port 443))
- (.setKeystore (options :keystore))
- (.setKeyPassword (options :key-password)))
- (when (options :truststore)
- (.setTruststore ssl-connector (options :truststore)))
- (when (options :trust-password)
- (.setTrustPassword ssl-connector (options :trust-password)))
- (.addConnector server ssl-connector)))
-
-(defn- create-server
- "Construct a Jetty Server instance."
- [options servlets]
- (let [connector (doto (SocketConnector.)
- (.setPort (options :port 80))
- (.setHost (options :host)))
- server (doto (Server.)
- (.addConnector connector))
- servlets (partition 2 servlets)]
- (when (or (options :ssl) (options :ssl-port))
- (add-ssl-connector! server options))
- (doseq [[url-or-path servlet] servlets]
- (add-servlet! server url-or-path servlet))
- server))
-
-(defn jetty-server
- "Create a new Jetty HTTP server with the supplied options and servlets."
- [options? & servlets]
- (server-with-options create-server options? servlets))
-
-(defmacro defserver
- "Shortcut for (def name (http-server args))"
- [name & args]
- `(def ~name (jetty-server ~@args)))
-
-(defn start "Start a HTTP server."
- [server]
- (.start server))
-
-(defn stop "Stop a HTTP server."
- [server]
- (.stop server))
-
-(defn run-server
- "Create and start a new Jetty HTTP server."
- [& server-args]
- (let [server (apply jetty-server server-args)]
- (.start server)
- server))
86 src/compojure/str_utils.clj
View
@@ -1,86 +0,0 @@
-;; 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.str-utils
- "Utility functions for manipulating strings."
- (:use clojure.contrib.seq-utils
- clojure.contrib.str-utils)
- (:import clojure.lang.Named))
-
-(defn escape
- "Returns a string with each occurance of a character in
- chars escaped."
- [chars #^String string]
- (let [charset (set chars)]
- (apply str
- (mapcat
- #(if (contains? charset %) [\\ %] [%])
- string))))
-
-(defn map-str
- "Map a function to a collection, then concatenate the results into a
- string."
- [func coll]
- (apply str (map func coll)))
-
-(defn indent
- "Indent each line in a string of text. Defaults to an indentation of two
- spaces."
- ([text]
- (indent text " "))
- ([text spacer]
- (map-str
- #(str spacer % "\n")
- (re-split #"\n" text))))
-
-(defn str*
- "A version of str that prefers the names of Named objects.
- e.g (str \"Hello \" :World) => \"Hello :World\"
- (str* \"Hello \" :World) => \"Hello World\""
- [& args]
- (map-str
- #(if (instance? Named %) (name %) (str %))
- args))
-
-(defn re-escape
- "Escape all special regex chars in string."
- [string]
- (escape "\\.*+|?()[]{}$^" string))
-
-(defn re-groups*
- "