diff options
53 files changed, 3604 insertions, 8 deletions
diff --git a/bin/repl.bat b/bin/repl.bat index 5dab8ae..e06c6ef 100755 --- a/bin/repl.bat +++ b/bin/repl.bat @@ -1,3 +1,3 @@ REM Windows REPL script -java -server -cp lib/commons-io-1.4.jar;lib/commons-fileupload-1.2.1.jar;lib/commons-codec-1.3.jar;lib/clojure.jar;lib/clojure-contrib.jar;lib/compojure.jar;lib/jetty-6.1.14.jar;lib/jetty-util-6.1.14.jar;lib/servlet-api-2.5-6.1.14.jar;lib/jline-0.9.94.jar;lib/postgresql-8.4-701.jdbc4.jar;lib/stringtemplate-3.2.1.jar;lib/antlr-2.7.7.jar jline.ConsoleRunner clojure.lang.Repl %1
\ No newline at end of file +java -server -cp lib/commons-io-1.4.jar;lib/commons-fileupload-1.2.1.jar;lib/commons-codec-1.3.jar;lib/clojure.jar;lib/clojure-contrib.jar;lib/compojure-3.2v1.jar;lib/jetty-6.1.14.jar;lib/jetty-util-6.1.14.jar;lib/servlet-api-2.5-6.1.14.jar;lib/jline-0.9.94.jar;lib/postgresql-8.4-701.jdbc4.jar;lib/stringtemplate-3.2.1.jar;lib/antlr-2.7.7.jar jline.ConsoleRunner clojure.lang.Repl %1
\ No newline at end of file diff --git a/bin/repl.sh b/bin/repl.sh index 9267ad2..a7308df 100755 --- a/bin/repl.sh +++ b/bin/repl.sh @@ -1,3 +1,3 @@ #!/bin/sh -java -server -cp .:lib/commons-io-1.4.jar:lib/commons-fileupload-1.2.1.jar:lib/commons-codec-1.3.jar:lib/jline-0.9.94.jar:lib/clojure.jar:lib/clojure-contrib.jar:lib/compojure.jar:lib/jetty-6.1.14.jar:lib/jetty-util-6.1.14.jar:lib/servlet-api-2.5-6.1.14.jar:lib/postgresql-8.4-701.jdbc4.jar:lib/stringtemplate-3.2.1.jar:lib/antlr-2.7.7.jar jline.ConsoleRunner clojure.lang.Repl $1 +java -server -cp .:lib/commons-io-1.4.jar:lib/commons-fileupload-1.2.1.jar:lib/commons-codec-1.3.jar:lib/jline-0.9.94.jar:lib/clojure.jar:lib/clojure-contrib.jar:lib/compojure-3.2v1.jar:lib/jetty-6.1.14.jar:lib/jetty-util-6.1.14.jar:lib/servlet-api-2.5-6.1.14.jar:lib/postgresql-8.4-701.jdbc4.jar:lib/stringtemplate-3.2.1.jar:lib/antlr-2.7.7.jar jline.ConsoleRunner clojure.lang.Repl $1 diff --git a/bin/run.bat b/bin/run.bat deleted file mode 100755 index 11ed49c..0000000 --- a/bin/run.bat +++ /dev/null @@ -1,3 +0,0 @@ -REM Windows runner script - -java -server -cp lib/commons-io-1.4.jar;lib/commons-fileupload-1.2.1.jar;lib/commons-codec-1.3.jar;lib/clojure.jar;lib/clojure-contrib.jar;lib/compojure.jar;lib/jetty-6.1.14.jar;lib/jetty-util-6.1.14.jar;lib/servlet-api-2.5-6.1.14.jar clojure.lang.Script %1
\ No newline at end of file diff --git a/bin/run.sh b/bin/run.sh deleted file mode 100755 index e9ad859..0000000 --- a/bin/run.sh +++ /dev/null @@ -1,3 +0,0 @@ -#!/bin/sh - -java -server -cp .:lib/commons-io-1.4.jar:lib/commons-fileupload-1.2.1.jar:lib/commons-codec-1.3.jar:lib/clojure.jar:lib/clojure-contrib.jar:lib/compojure.jar:lib/jetty-6.1.14.jar:lib/jetty-util-6.1.14.jar:lib/servlet-api-2.5-6.1.14.jar:classes clojure.lang.Script $1 diff --git a/compojure-3.2/.gitignore b/compojure-3.2/.gitignore new file mode 100755 index 0000000..4785a5b --- /dev/null +++ b/compojure-3.2/.gitignore @@ -0,0 +1,6 @@ +lib +classes +compojure.jar +deps +deps.zip +pom.xml diff --git a/compojure-3.2/README.markdown b/compojure-3.2/README.markdown new file mode 100755 index 0000000..b5b6021 --- /dev/null +++ b/compojure-3.2/README.markdown @@ -0,0 +1,62 @@ +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/) diff --git a/compojure-3.2/build.xml b/compojure-3.2/build.xml new file mode 100755 index 0000000..a8418ab --- /dev/null +++ b/compojure-3.2/build.xml @@ -0,0 +1,90 @@ +<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> diff --git a/compojure-3.2/compojure-3.2v1.jar b/compojure-3.2/compojure-3.2v1.jar Binary files differnew file mode 100755 index 0000000..c41f5e9 --- /dev/null +++ b/compojure-3.2/compojure-3.2v1.jar diff --git a/compojure-3.2/epl-v10.html b/compojure-3.2/epl-v10.html new file mode 100755 index 0000000..84ec251 --- /dev/null +++ b/compojure-3.2/epl-v10.html @@ -0,0 +1,261 @@ +<?xml version="1.0" encoding="ISO-8859-1" ?> +<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> +<html xmlns="http://www.w3.org/1999/xhtml"> + +<head> +<meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1" /> +<title>Eclipse Public License - Version 1.0</title> +<style type="text/css"> + body { + size: 8.5in 11.0in; + margin: 0.25in 0.5in 0.25in 0.5in; + tab-interval: 0.5in; + } + p { + margin-left: auto; + margin-top: 0.5em; + margin-bottom: 0.5em; + } + p.list { + margin-left: 0.5in; + margin-top: 0.05em; + margin-bottom: 0.05em; + } + </style> + +</head> + +<body lang="EN-US"> + +<p align=center><b>Eclipse Public License - v 1.0</b></p> + +<p>THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE +PUBLIC LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR +DISTRIBUTION OF THE PROGRAM CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS +AGREEMENT.</p> + +<p><b>1. DEFINITIONS</b></p> + +<p>"Contribution" means:</p> + +<p class="list">a) in the case of the initial Contributor, the initial +code and documentation distributed under this Agreement, and</p> +<p class="list">b) in the case of each subsequent Contributor:</p> +<p class="list">i) changes to the Program, and</p> +<p class="list">ii) additions to the Program;</p> +<p class="list">where such changes and/or additions to the Program +originate from and are distributed by that particular Contributor. A +Contribution 'originates' from a Contributor if it was added to the +Program by such Contributor itself or anyone acting on such +Contributor's behalf. Contributions do not include additions to the +Program which: (i) are separate modules of software distributed in +conjunction with the Program under their own license agreement, and (ii) +are not derivative works of the Program.</p> + +<p>"Contributor" means any person or entity that distributes +the Program.</p> + +<p>"Licensed Patents" mean patent claims licensable by a +Contributor which are necessarily infringed by the use or sale of its +Contribution alone or when combined with the Program.</p> + +<p>"Program" means the Contributions distributed in accordance +with this Agreement.</p> + +<p>"Recipient" means anyone who receives the Program under +this Agreement, including all Contributors.</p> + +<p><b>2. GRANT OF RIGHTS</b></p> + +<p class="list">a) Subject to the terms of this Agreement, each +Contributor hereby grants Recipient a non-exclusive, worldwide, +royalty-free copyright license to reproduce, prepare derivative works +of, publicly display, publicly perform, distribute and sublicense the +Contribution of such Contributor, if any, and such derivative works, in +source code and object code form.</p> + +<p class="list">b) Subject to the terms of this Agreement, each +Contributor hereby grants Recipient a non-exclusive, worldwide, +royalty-free patent license under Licensed Patents to make, use, sell, +offer to sell, import and otherwise transfer the Contribution of such +Contributor, if any, in source code and object code form. This patent +license shall apply to the combination of the Contribution and the +Program if, at the time the Contribution is added by the Contributor, +such addition of the Contribution causes such combination to be covered +by the Licensed Patents. The patent license shall not apply to any other +combinations which include the Contribution. No hardware per se is +licensed hereunder.</p> + +<p class="list">c) Recipient understands that although each Contributor +grants the licenses to its Contributions set forth herein, no assurances +are provided by any Contributor that the Program does not infringe the +patent or other intellectual property rights of any other entity. Each +Contributor disclaims any liability to Recipient for claims brought by +any other entity based on infringement of intellectual property rights +or otherwise. As a condition to exercising the rights and licenses +granted hereunder, each Recipient hereby assumes sole responsibility to +secure any other intellectual property rights needed, if any. For +example, if a third party patent license is required to allow Recipient +to distribute the Program, it is Recipient's responsibility to acquire +that license before distributing the Program.</p> + +<p class="list">d) Each Contributor represents that to its knowledge it +has sufficient copyright rights in its Contribution, if any, to grant +the copyright license set forth in this Agreement.</p> + +<p><b>3. REQUIREMENTS</b></p> + +<p>A Contributor may choose to distribute the Program in object code +form under its own license agreement, provided that:</p> + +<p class="list">a) it complies with the terms and conditions of this +Agreement; and</p> + +<p class="list">b) its license agreement:</p> + +<p class="list">i) effectively disclaims on behalf of all Contributors +all warranties and conditions, express and implied, including warranties +or conditions of title and non-infringement, and implied warranties or +conditions of merchantability and fitness for a particular purpose;</p> + +<p class="list">ii) effectively excludes on behalf of all Contributors +all liability for damages, including direct, indirect, special, +incidental and consequential damages, such as lost profits;</p> + +<p class="list">iii) states that any provisions which differ from this +Agreement are offered by that Contributor alone and not by any other +party; and</p> + +<p class="list">iv) states that source code for the Program is available +from such Contributor, and informs licensees how to obtain it in a +reasonable manner on or through a medium customarily used for software +exchange.</p> + +<p>When the Program is made available in source code form:</p> + +<p class="list">a) it must be made available under this Agreement; and</p> + +<p class="list">b) a copy of this Agreement must be included with each +copy of the Program.</p> + +<p>Contributors may not remove or alter any copyright notices contained +within the Program.</p> + +<p>Each Contributor must identify itself as the originator of its +Contribution, if any, in a manner that reasonably allows subsequent +Recipients to identify the originator of the Contribution.</p> + +<p><b>4. COMMERCIAL DISTRIBUTION</b></p> + +<p>Commercial distributors of software may accept certain +responsibilities with respect to end users, business partners and the +like. While this license is intended to facilitate the commercial use of +the Program, the Contributor who includes the Program in a commercial +product offering should do so in a manner which does not create +potential liability for other Contributors. Therefore, if a Contributor +includes the Program in a commercial product offering, such Contributor +("Commercial Contributor") hereby agrees to defend and +indemnify every other Contributor ("Indemnified Contributor") +against any losses, damages and costs (collectively "Losses") +arising from claims, lawsuits and other legal actions brought by a third +party against the Indemnified Contributor to the extent caused by the +acts or omissions of such Commercial Contributor in connection with its +distribution of the Program in a commercial product offering. The +obligations in this section do not apply to any claims or Losses +relating to any actual or alleged intellectual property infringement. In +order to qualify, an Indemnified Contributor must: a) promptly notify +the Commercial Contributor in writing of such claim, and b) allow the +Commercial Contributor to control, and cooperate with the Commercial +Contributor in, the defense and any related settlement negotiations. The +Indemnified Contributor may participate in any such claim at its own +expense.</p> + +<p>For example, a Contributor might include the Program in a commercial +product offering, Product X. That Contributor is then a Commercial +Contributor. If that Commercial Contributor then makes performance +claims, or offers warranties related to Product X, those performance +claims and warranties are such Commercial Contributor's responsibility +alone. Under this section, the Commercial Contributor would have to +defend claims against the other Contributors related to those +performance claims and warranties, and if a court requires any other +Contributor to pay any damages as a result, the Commercial Contributor +must pay those damages.</p> + +<p><b>5. NO WARRANTY</b></p> + +<p>EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS +PROVIDED ON AN "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS +OF ANY KIND, EITHER EXPRESS OR IMPLIED INCLUDING, WITHOUT LIMITATION, +ANY WARRANTIES OR CONDITIONS OF TITLE, NON-INFRINGEMENT, MERCHANTABILITY +OR FITNESS FOR A PARTICULAR PURPOSE. Each Recipient is solely +responsible for determining the appropriateness of using and +distributing the Program and assumes all risks associated with its +exercise of rights under this Agreement , including but not limited to +the risks and costs of program errors, compliance with applicable laws, +damage to or loss of data, programs or equipment, and unavailability or +interruption of operations.</p> + +<p><b>6. DISCLAIMER OF LIABILITY</b></p> + +<p>EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT +NOR ANY CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, +INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING +WITHOUT LIMITATION LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF +LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OR +DISTRIBUTION OF THE PROGRAM OR THE EXERCISE OF ANY RIGHTS GRANTED +HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.</p> + +<p><b>7. GENERAL</b></p> + +<p>If any provision of this Agreement is invalid or unenforceable under +applicable law, it shall not affect the validity or enforceability of +the remainder of the terms of this Agreement, and without further action +by the parties hereto, such provision shall be reformed to the minimum +extent necessary to make such provision valid and enforceable.</p> + +<p>If Recipient institutes patent litigation against any entity +(including a cross-claim or counterclaim in a lawsuit) alleging that the +Program itself (excluding combinations of the Program with other +software or hardware) infringes such Recipient's patent(s), then such +Recipient's rights granted under Section 2(b) shall terminate as of the +date such litigation is filed.</p> + +<p>All Recipient's rights under this Agreement shall terminate if it +fails to comply with any of the material terms or conditions of this +Agreement and does not cure such failure in a reasonable period of time +after becoming aware of such noncompliance. If all Recipient's rights +under this Agreement terminate, Recipient agrees to cease use and +distribution of the Program as soon as reasonably practicable. However, +Recipient's obligations under this Agreement and any licenses granted by +Recipient relating to the Program shall continue and survive.</p> + +<p>Everyone is permitted to copy and distribute copies of this +Agreement, but in order to avoid inconsistency the Agreement is +copyrighted and may only be modified in the following manner. The +Agreement Steward reserves the right to publish new versions (including +revisions) of this Agreement from time to time. No one other than the +Agreement Steward has the right to modify this Agreement. The Eclipse +Foundation is the initial Agreement Steward. The Eclipse Foundation may +assign the responsibility to serve as the Agreement Steward to a +suitable separate entity. Each new version of the Agreement will be +given a distinguishing version number. The Program (including +Contributions) may always be distributed subject to the version of the +Agreement under which it was received. In addition, after a new version +of the Agreement is published, Contributor may elect to distribute the +Program (including its Contributions) under the new version. Except as +expressly stated in Sections 2(a) and 2(b) above, Recipient receives no +rights or licenses to the intellectual property of any Contributor under +this Agreement, whether expressly, by implication, estoppel or +otherwise. All rights in the Program not expressly granted under this +Agreement are reserved.</p> + +<p>This Agreement is governed by the laws of the State of New York and +the intellectual property laws of the United States of America. No party +to this Agreement will bring a legal action under this Agreement more +than one year after the cause of action arose. Each party waives its +rights to a jury trial in any resulting litigation.</p> + +</body> + +</html> diff --git a/compojure-3.2/project.clj b/compojure-3.2/project.clj new file mode 100755 index 0000000..4fbf80c --- /dev/null +++ b/compojure-3.2/project.clj @@ -0,0 +1,27 @@ +(defproject compojure "0.3.2" + :description "A concise web framework for Clojure" + :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]) diff --git a/compojure-3.2/src/compojure.clj b/compojure-3.2/src/compojure.clj new file mode 100755 index 0000000..7831374 --- /dev/null +++ b/compojure-3.2/src/compojure.clj @@ -0,0 +1,29 @@ +;; 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) diff --git a/compojure-3.2/src/compojure/control.clj b/compojure-3.2/src/compojure/control.clj new file mode 100755 index 0000000..ea45c69 --- /dev/null +++ b/compojure-3.2/src/compojure/control.clj @@ -0,0 +1,73 @@ +;; 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)))) diff --git a/compojure-3.2/src/compojure/crypto.clj b/compojure-3.2/src/compojure/crypto.clj new file mode 100755 index 0000000..937bad5 --- /dev/null +++ b/compojure-3.2/src/compojure/crypto.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.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 "AES/" (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))))) diff --git a/compojure-3.2/src/compojure/encodings.clj b/compojure-3.2/src/compojure/encodings.clj new file mode 100755 index 0000000..6587d48 --- /dev/null +++ b/compojure-3.2/src/compojure/encodings.clj @@ -0,0 +1,64 @@ +;; 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))) diff --git a/compojure-3.2/src/compojure/html.clj b/compojure-3.2/src/compojure/html.clj new file mode 100755 index 0000000..d106263 --- /dev/null +++ b/compojure-3.2/src/compojure/html.clj @@ -0,0 +1,16 @@ +;; 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) diff --git a/compojure-3.2/src/compojure/html/form_helpers.clj b/compojure-3.2/src/compojure/html/form_helpers.clj new file mode 100755 index 0000000..9da2ef9 --- /dev/null +++ b/compojure-3.2/src/compojure/html/form_helpers.clj @@ -0,0 +1,169 @@ +;; 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))) diff --git a/compojure-3.2/src/compojure/html/gen.clj b/compojure-3.2/src/compojure/html/gen.clj new file mode 100755 index 0000000..617190d --- /dev/null +++ b/compojure-3.2/src/compojure/html/gen.clj @@ -0,0 +1,124 @@ +;; 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 "&" "&") + (replace "<" "<") + (replace ">" ">") + (replace "\"" """))) + +(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))) diff --git a/compojure-3.2/src/compojure/html/page_helpers.clj b/compojure-3.2/src/compojure/html/page_helpers.clj new file mode 100755 index 0000000..8c10e30 --- /dev/null +++ b/compojure-3.2/src/compojure/html/page_helpers.clj @@ -0,0 +1,103 @@ +;; 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) diff --git a/compojure-3.2/src/compojure/http.clj b/compojure-3.2/src/compojure/http.clj new file mode 100755 index 0000000..af9881a --- /dev/null +++ b/compojure-3.2/src/compojure/http.clj @@ -0,0 +1,19 @@ +;; 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) diff --git a/compojure-3.2/src/compojure/http/helpers.clj b/compojure-3.2/src/compojure/http/helpers.clj new file mode 100755 index 0000000..f60eeb9 --- /dev/null +++ b/compojure-3.2/src/compojure/http/helpers.clj @@ -0,0 +1,76 @@ +;; 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)))))) diff --git a/compojure-3.2/src/compojure/http/middleware.clj b/compojure-3.2/src/compojure/http/middleware.clj new file mode 100755 index 0000000..f9a2dab --- /dev/null +++ b/compojure-3.2/src/compojure/http/middleware.clj @@ -0,0 +1,131 @@ +;; 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] + (second (re-find #"\.(\w*$)" 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))))) diff --git a/compojure-3.2/src/compojure/http/multipart.clj b/compojure-3.2/src/compojure/http/multipart.clj new file mode 100755 index 0000000..afd6737 --- /dev/null +++ b/compojure-3.2/src/compojure/http/multipart.clj @@ -0,0 +1,80 @@ +;; 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)))) diff --git a/compojure-3.2/src/compojure/http/request.clj b/compojure-3.2/src/compojure/http/request.clj new file mode 100755 index 0000000..8c09616 --- /dev/null +++ b/compojure-3.2/src/compojure/http/request.clj @@ -0,0 +1,109 @@ +;; 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)))) diff --git a/compojure-3.2/src/compojure/http/response.clj b/compojure-3.2/src/compojure/http/response.clj new file mode 100755 index 0000000..269e71d --- /dev/null +++ b/compojure-3.2/src/compojure/http/response.clj @@ -0,0 +1,106 @@ +;; 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)) diff --git a/compojure-3.2/src/compojure/http/routes.clj b/compojure-3.2/src/compojure/http/routes.clj new file mode 100755 index 0000000..d722a57 --- /dev/null +++ b/compojure-3.2/src/compojure/http/routes.clj @@ -0,0 +1,243 @@ +;; 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)) 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)))) diff --git a/compojure-3.2/src/compojure/http/session.clj b/compojure-3.2/src/compojure/http/session.clj new file mode 100755 index 0000000..d176dec --- /dev/null +++ b/compojure-3.2/src/compojure/http/session.clj @@ -0,0 +1,243 @@ +;; 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)})) diff --git a/compojure-3.2/src/compojure/map_utils.clj b/compojure-3.2/src/compojure/map_utils.clj new file mode 100755 index 0000000..853c90c --- /dev/null +++ b/compojure-3.2/src/compojure/map_utils.clj @@ -0,0 +1,21 @@ +;; 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))) diff --git a/compojure-3.2/src/compojure/ns_utils.clj b/compojure-3.2/src/compojure/ns_utils.clj new file mode 100755 index 0000000..5e26ab2 --- /dev/null +++ b/compojure-3.2/src/compojure/ns_utils.clj @@ -0,0 +1,23 @@ +;; 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)))))) diff --git a/compojure-3.2/src/compojure/server/common.clj b/compojure-3.2/src/compojure/server/common.clj new file mode 100755 index 0000000..b31fbd6 --- /dev/null +++ b/compojure-3.2/src/compojure/server/common.clj @@ -0,0 +1,26 @@ +;; 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)))) diff --git a/compojure-3.2/src/compojure/server/grizzly.clj b/compojure-3.2/src/compojure/server/grizzly.clj new file mode 100755 index 0000000..c33a1d5 --- /dev/null +++ b/compojure-3.2/src/compojure/server/grizzly.clj @@ -0,0 +1,74 @@ +;; 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)) diff --git a/compojure-3.2/src/compojure/server/jetty.clj b/compojure-3.2/src/compojure/server/jetty.clj new file mode 100755 index 0000000..f69d94c --- /dev/null +++ b/compojure-3.2/src/compojure/server/jetty.clj @@ -0,0 +1,106 @@ +;; 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)) diff --git a/compojure-3.2/src/compojure/str_utils.clj b/compojure-3.2/src/compojure/str_utils.clj new file mode 100755 index 0000000..78c6b92 --- /dev/null +++ b/compojure-3.2/src/compojure/str_utils.clj @@ -0,0 +1,86 @@ +;; 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* + "More consistant re-groups that always returns a vector of groups, even if + there is only one group." + [matcher] + (for [i (range (.groupCount matcher))] + (.group matcher (inc i)))) + +(defn blank? + "True if s = \"\" or nil" + [s] + (or (nil? s) (= s ""))) + +(defn lines + "Concatenate a sequence of strings into lines of a single string." + [coll] + (str-join "\n" coll)) + +(defn capitalize + "Uppercase the first letter of a string, and lowercase the rest." + [s] + (str (.toUpperCase (subs s 0 1)) + (.toLowerCase (subs s 1)))) + +(defn grep + "Filter a collection of strings by a regex." + [re coll] + (filter (partial re-find re) coll)) + +(defn upcase-name + "Upcase a symbol or keyword's name." + [sym] + (. (name sym) toUpperCase)) diff --git a/compojure-3.2/src/compojure/validation.clj b/compojure-3.2/src/compojure/validation.clj new file mode 100755 index 0000000..35e8e32 --- /dev/null +++ b/compojure-3.2/src/compojure/validation.clj @@ -0,0 +1,91 @@ +;; 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.validation + "Functions for validating form parameters." + (:use compojure.control + compojure.html.form-helpers + compojure.html.page-helpers + clojure.contrib.def)) + +(defvar *errors* {} + "Var containing validation errors.") + +(load "validation/predicates") + +(defn validate + "Validate a single parameter, or group of parameters, using a predicate. If + the predicate fails, a validation error is returned. For a single parameter, + use the following form: + (validate params name pred message) + This will use the value of (pred (params name)) to determine if the parameter + is valid. For multiple parameters: + (validate params pred message) + This will use the value of (pred params) to determine validity." + ([params pred message] + (if (pred params) + {} + {nil [message]})) + ([params name pred message] + (if (pred (params name)) + {} + {name [message]}))) + +(defn merge-errors + "Merge a set of validation errors into a single hash map." + [& results] + (apply merge-with #(into [] (concat %1 %2)) results)) + +(defn validation + "Convinience function to perform a series of validations on a map of params. + Takes a set of params and a collection of argument vectors for the validate + function: + e.g. (validation params + [name pred message] + [pred message]) + Is the same as: + (merge-errors + (validate params name pred message) + (validate params pred message))" + [params & validations] + (apply merge-errors + (map #(apply validate params %) validations))) + +(defn validation-errors? + "True if there are errors in the var *errors*." + [] + (seq *errors*)) + +(defmacro with-validation + "Binds *errors* to (validation-fn *params*)." + [validation-fn & body] + `(binding [*errors* (~validation-fn *params*)] + ~@body)) + +(defmacro with-validated-params + "Equivalent to (with-params params (with-validation validation-fn))." + [params validation-fn & body] + `(with-params ~params + (with-validation ~validation-fn + ~@body))) + +(defn error-summary + "Returns a summary of the errors on the form in HTML." + [] + (unordered-list (apply concat (vals *errors*)))) + +(defn error-class + "Decorator function that marks an input field with an error class if the + parameter has errors." + [func] + (fn [name & args] + (let [errors (*errors* name) + result (apply func name args)] + (if (seq errors) + [:div.error result] + result)))) diff --git a/compojure-3.2/src/compojure/validation/predicates.clj b/compojure-3.2/src/compojure/validation/predicates.clj new file mode 100755 index 0000000..30cda60 --- /dev/null +++ b/compojure-3.2/src/compojure/validation/predicates.clj @@ -0,0 +1,20 @@ +;; 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.validation.predicates + (:use compojure.str-utils)) + +(defn present? + "True if x is not nil and not an empty string." + [x] + (not (blank? x))) + +(defn max-size + "Returns a function to check a maximum size of a collection." + [n] + #(<= (count %) n)) diff --git a/compojure-3.2/test/compojure/crypto_test.clj b/compojure-3.2/test/compojure/crypto_test.clj new file mode 100755 index 0000000..ee309e6 --- /dev/null +++ b/compojure-3.2/test/compojure/crypto_test.clj @@ -0,0 +1,35 @@ +(ns compojure.crypto-test + (:use compojure.crypto + clojure.contrib.test-is)) + +(deftest secret-key-length + (are (= (count (gen-secret-key {:key-size _1})) _2) + 256 32 + 128 16)) + +(deftest secret-key-uniqueness + (let [a (gen-secret-key {:key-size 128}) + b (gen-secret-key {:key-size 128})] + (is (not= a b)))) + +(def secret-key + (.getBytes "0123456789ABCDEF")) + +(deftest seal-string + (is (not= (seal secret-key "Foobar") "Foobar"))) + +(deftest seal-uniqueness + (let [a (seal secret-key "Foobar") + b (seal secret-key "Foobar")] + (is (not= a b)))) + +(deftest seal-then-unseal + (are (= (unseal secret-key (seal secret-key _1)) _1) + "Foobar" + [1 2 3] + {:a 10})) + +(deftest seal-then-tamper + (let [data (seal secret-key "Foobar") + data (apply str "A" (rest data))] + (is (nil? (unseal secret-key "Foobar"))))) diff --git a/compojure-3.2/test/compojure/html/form_helpers_test.clj b/compojure-3.2/test/compojure/html/form_helpers_test.clj new file mode 100755 index 0000000..b01f3ed --- /dev/null +++ b/compojure-3.2/test/compojure/html/form_helpers_test.clj @@ -0,0 +1,118 @@ +(ns compojure.html.form-helpers-test + (:use compojure.html.form-helpers + clojure.contrib.test-is)) + +(defn attribute + "Get an attribute from a tag vector." + [tag key] + ((second tag) key)) + +(deftest test-hidden-field + (testing "passing in only name" + (is (= [:input {:type "hidden", :name "foo", :id "foo"}] + (hidden-field "foo")))) + (testing "passing in name and value" + (is (= [:input {:value "hidden", :type "hidden", :name "foo", :id "foo"}] + (hidden-field "foo" "hidden"))))) + +(deftest test-text-field + (testing "passing in only name" + (is (= [:input {:type "text", :id "foo", :name "foo"}] + (text-field :foo)))) + (testing "passing in name and value" + (is (= [:input {:value :text-field, :type "text", :name "foo", :id "foo"}] + (text-field :foo :text-field))))) + +(deftest test-password-field + (is (= [:input {:type "password", :id "foo", :name "foo" :value ""}] + (password-field "foo")))) + +(deftest test-check-box + (testing "passing in only name" + (is (= [:input {:type "checkbox" :id "foo" :name "foo" :value "true" :checked nil}] + (check-box :foo)))) + (testing "passing in name and checked" + (is (= [:input {:type "checkbox", :name "foo", :id "foo", :value "true", :checked true}] + (check-box :foo true)))) + (testing "passing in name, checked, and value" + (is (= [:input {:type "checkbox", :name "foo", :id "foo", :value "checkbox", :checked false}] + (check-box :foo false "checkbox"))))) + +(deftest test-radio-button + (testing "passing in only name" + (is (= [:input {:type "radio" :id "foo_true" :name "foo" :value "true" :checked nil}] + (radio-button :foo)))) + (testing "passing in name and checked" + (is (= [:input {:type "radio", :name "foo", :id "foo_true", :value "true", :checked true}] + (radio-button :foo true)))) + (testing "passing in name, checked, and value" + (is (= [:input {:type "radio", :name "foo", :id "foo_radio", :value "radio", :checked false}] + (radio-button :foo false "radio"))))) + +(deftest test-select-options + (testing "passing in only options" + (is (= '([:option {:value "1"} "a"] + [:option {:value "2"} "b"] + [:option {:value "3"} "c"]) + (select-options [["a" "1"] ["b" "2"] ["c" "3"]])))) + (testing "passing in options and selected" + (is (= '([:option {:selected "selected" :value "1"} "a"] + [:option {:value "2"} "b"]) + (select-options [["a" "1"] ["b" "2"]] "1"))))) + +(deftest test-drop-down + (testing "passing in name and options" + (is (= [:select {:name "foo", :id "foo"} + '([:option {:value "1"} "a"] + [:option {:value "2"} "b"])] + (drop-down :foo [["a" "1"] ["b" "2"]])))) + (testing "passing in name, options, and selected" + (is (= [:select {:id "foo" :name "foo"} + '([:option {:value "1"} "a"] + [:option {:value "2" :selected "selected"} "b"] + [:option {:value "3"} "c"])] + (drop-down :foo [["a" "1"] ["b" "2"] ["c" "3"]] "2"))))) + +(deftest test-text-area + (testing "passing in only name" + (is (= [:textarea {:name "text", :id "text"} nil] + (text-area "text")))) + (testing "passing in name and value" + (is (= [:textarea {:name "text", :id "text"} "textarea"] + (text-area "text" "textarea"))))) + +(deftest test-label + (is (= [:label {:for "label"} "labeltext"] + (label "label" "labeltext")))) + +(deftest test-submit-button + (is (= [:input {:type "submit", :value "submit"}] + (submit-button "submit")))) + +(deftest test-reset-button + (is (= [:input {:type "reset", :value "reset"}] + (reset-button "reset")))) + +(deftest test-form-to + (let [form (form-to [:post "action"] [])] + (is (= (attribute form :method) "POST")))) + +(deftest test-form-to-update + (let [form (form-to [:update "action"] [])] + (is (= (attribute form :method) "POST")) + (let [hidden (nth form 2)] + (is (= (attribute hidden :value) "UPDATE")) + (is (= (attribute hidden :name) "_method")) + (is (= (attribute hidden :type) "hidden"))))) + +(deftest test-form-to-attrs + (let [form (form-to {:class "class" } [:post "action"] [])] + (is (= (attribute form :class) "class")))) + +(deftest form-input-attrs + (let [field (text-field {:style "color: red;"} :foo)] + (is (= (attribute field :style) "color: red;")))) + +(deftest test-with-params + (is (= (with-params {:foo "bar"} (text-field :foo)) + [:input {:type "text", :id "foo", :name "foo", :value "bar"}])))
\ No newline at end of file diff --git a/compojure-3.2/test/compojure/html/gen_test.clj b/compojure-3.2/test/compojure/html/gen_test.clj new file mode 100755 index 0000000..5d64b7c --- /dev/null +++ b/compojure-3.2/test/compojure/html/gen_test.clj @@ -0,0 +1,93 @@ +(ns compojure.html.gen-test + (:use compojure.html.gen + clojure.contrib.test-is)) + +(deftest tag-text + (is (= (html [:text "Lorem Ipsum"]) "<text>Lorem Ipsum</text>"))) + +(deftest empty-tags + (is (= (html [:text]) "<text />"))) + +(deftest empty-block-tags + (is (= (html [:div]) "<div></div>")) + (is (= (html [:h1]) "<h1></h1>")) + (is (= (html [:script]) "<script></script>"))) + +(deftest empty-links-tag + (is (= (html [:a]) "<a></a>"))) + +(deftest tags-can-be-strs + (is (= (html ["div"] "<div></div>")))) + +(deftest tags-can-be-symbols + (is (= (html ['div] "<div></div>")))) + +(deftest tag-concatenation + (is (= (html [:body "foo" "bar"]) "<body>foobar</body>")) + (is (= (html [:body [:p] [:br]])) "<body><p /><br /></body>")) + +(deftest tag-seq-expand + (is (= (html [:body (list "foo" "bar")]) + "<body>foobar</body>"))) + +(deftest html-seq-expand + (is (= (html (list [:p "a"] [:p "b"])) + "<p>a</p><p>b</p>"))) + +(deftest nested-tags + (is (= (html [:div [:p]] "<div><p /></div>"))) + (is (= (html [:div [:b]] "<div><b></b></div>"))) + (is (= (html [:p [:span [:a "foo"]]]) + "<p><span><a>foo</a></span></p>"))) + +(deftest attribute-maps + (is (= (html [:xml {:a "1", :b "2"}]) + "<xml a=\"1\" b=\"2\" />"))) + +(deftest blank-attribute-map + (is (= (html [:xml {}]) "<xml />"))) + +(deftest escaped-chars + (is (= (escape-html "\"") """)) + (is (= (escape-html "<") "<")) + (is (= (escape-html ">") ">")) + (is (= (escape-html "&") "&"))) + +(deftest escaped-attrs + (is (= (html [:div {:id "\""}]) + "<div id=\""\"></div>"))) + +(deftest attrs-can-be-strs + (is (= (html [:img {"id" "foo"}]) "<img id=\"foo\" />"))) + +(deftest attrs-can-be-symbols + (is (= (html [:img {'id "foo"}]) "<img id=\"foo\" />"))) + +(deftest attr-keys-different-types + (is (= (html [:xml {:a "1", 'b "2", "c" "3"}]) + "<xml a=\"1\" b=\"2\" c=\"3\" />"))) + +(deftest tag-class-sugar + (is (= (html [:div.foo]) "<div class=\"foo\"></div>"))) + +(deftest tag-many-class-sugar + (is (= (html [:div.a.b]) "<div class=\"a b\"></div>")) + (is (= (html [:div.a.b.c]) "<div class=\"a b c\"></div>"))) + +(deftest tag-id-sugar + (is (= (html [:div#foo]) "<div id=\"foo\"></div>"))) + +(deftest tag-id-and-classes + (is (= (html [:div#foo.bar.baz]) + "<div class=\"bar baz\" id=\"foo\"></div>"))) + +(deftest html-not-indented + (is (= (html [:p "Lorem\nIpsum"]) "<p>Lorem\nIpsum</p>"))) + +(deftest attrs-bool-true + (is (= (html [:input {:type "checkbox" :checked true}]) + "<input checked=\"checked\" type=\"checkbox\" />"))) + +(deftest attrs-bool-false + (is (= (html [:input {:type "checkbox" :checked false}]) + "<input type=\"checkbox\" />"))) diff --git a/compojure-3.2/test/compojure/html/page_helpers_test.clj b/compojure-3.2/test/compojure/html/page_helpers_test.clj new file mode 100755 index 0000000..fe29481 --- /dev/null +++ b/compojure-3.2/test/compojure/html/page_helpers_test.clj @@ -0,0 +1,71 @@ +(ns compojure.html.page-helpers-test + (:use compojure.html.page-helpers + clojure.contrib.test-is)) + +(deftest test-doctype + (testing "html4" + (is (= (doctype :html4) + (str "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01//EN\" " + "\"http://www.w3.org/TR/html4/strict.dtd\">\n")))) + (testing "xhtml-strict" + (is (= (doctype :xhtml-strict) + (str "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" " + "\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n")))) + (testing "html5" + (is (= (doctype :html5) + (str "<!DOCTYPE html>")))) + (testing "xhtml-transitional" + (is (= (doctype :xhtml-transitional) + (str "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\" " + "\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">\n"))))) + +(deftest test-xhtml-tag + (is (= (xhtml-tag "test") + [:html {:xmlns "http://www.w3.org/1999/xhtml", "xml:lang" "test", :lang "test"} nil]))) + +(deftest test-include-js + (testing "one" + (is (= (include-js "foo.js") + '([:script {:type "text/javascript", :src "foo.js"}])))) + (testing "many" + (is (= (include-js "foo.js" "bar.js" "baz.js") + '([:script {:type "text/javascript", :src "foo.js"}] + [:script {:type "text/javascript", :src "bar.js"}] + [:script {:type "text/javascript", :src "baz.js"}]))))) + +(deftest test-include-css + (testing "one" + (is (= (include-css "foo.css") + '([:link {:type "text/css" :href "foo.css" :rel "stylesheet"}])))) + (testing "many" + (is (= (include-css "foo.css" "bar.css" "baz.css") + '([:link {:type "text/css", :href "foo.css", :rel "stylesheet"}] + [:link {:type "text/css", :href "bar.css", :rel "stylesheet"}] + [:link {:type "text/css", :href "baz.css", :rel "stylesheet"}]))))) + +(deftest test-javascript-tag + (is (= (javascript-tag "alert('hi');") + [:script {:type "text/javascript"} + (str "//<![CDATA[\n" "alert('hi');" "\n//]]>")]))) + +(deftest test-link-to + (is (= (link-to "http://compojure.org") + [:a {:href "http://compojure.org"} nil]))) + +(deftest test-url-encode + (is (= (url-encode "foo&bar*/baz.net") + (str "foo%26bar*%2Fbaz.net")))) + +(deftest test-url-params + (is (= (url-params "http://example.com" {:lang "en", :offset 10}) + "http://example.com?lang=en&offset=10"))) + +(deftest test-unordered-list + (is (= (unordered-list ["a" "b"]) + [:ul {} + '([:li "a"] [:li "b"])]))) + +(deftest test-ordered-list + (is (= (ordered-list ["b" "a"]) + [:ol {} + '([:li "b"] [:li "a"])])))
\ No newline at end of file diff --git a/compojure-3.2/test/compojure/http/helpers_test.clj b/compojure-3.2/test/compojure/http/helpers_test.clj new file mode 100755 index 0000000..fdd9a68 --- /dev/null +++ b/compojure-3.2/test/compojure/http/helpers_test.clj @@ -0,0 +1,21 @@ +(ns compojure.http.helpers-test + (:use compojure.http.helpers + compojure.http.routes + compojure.control + clojure.contrib.test-is)) + +(deftest test-set-cookie + (is (= (set-cookie :foo "bar") + {:headers {"Set-Cookie" "foo=bar"}}))) + +(deftest test-set-cookie-path + (is (= (set-cookie :a "b", :path "/") + {:headers {"Set-Cookie" "a=b; path=/"}}))) + +(deftest test-content-type + (is (= (content-type "text/html") + {:headers {"Content-Type" "text/html"}}))) + +(deftest test-safe-path + (is (not (safe-path? "/basedir/compojure" "../private/secret.txt"))) + (is (safe-path? "/basedir/compojure" "public/index.html"))) diff --git a/compojure-3.2/test/compojure/http/middleware_test.clj b/compojure-3.2/test/compojure/http/middleware_test.clj new file mode 100755 index 0000000..a3ddc8a --- /dev/null +++ b/compojure-3.2/test/compojure/http/middleware_test.clj @@ -0,0 +1,114 @@ +(ns compojure.http.middleware-test + (:use compojure.http.middleware + compojure.http.routes + clojure.contrib.test-is)) + +(deftest test-header-option + (is (= (header-option [:name "value"]) + "name=value"))) + +(deftest test-header-option-true + (is (= (header-option [:name true]) + "name"))) + +(deftest test-header-option-false + (is (nil? (header-option [:name false])))) + +(deftest test-header-options-multi + (let [m {:name "value", + :false false, + :true true}] + (is (= (header-options m ", ") + "name=value, true")))) + +(deftest test-header-options-single + (let [m {:name "value"}] + (is (= (header-options m ", ") + "name=value")))) + +(defn mock-middleware-response [f & args] + (let [routes (routes (GET "/foo" [{:headers {"k1" "v1" "k2" "v2"}} "body"])) + request {:request-method :get, + :uri "/foo"}] + ((apply f (conj args routes)) request))) + +(deftest test-with-headers + (let [headers {"name1" "value1", "name2" "value2"} + response (mock-middleware-response with-headers headers)] + (is (= "value1" (get (:headers response) "name1"))) + (is (= "value2" (get (:headers response) "name2"))) + (is (= "v1" (get (:headers response) "k1"))))) + +(deftest test-with-headers-overwrites + (let [headers {"k1" "vnew"} + response (mock-middleware-response with-headers headers)] + (is (= "vnew" (get (:headers response) "k1"))) + (is (= "v2" (get (:headers response) "k2"))))) + +(deftest test-with-cache-control + (let [m {:max-age 3600 :public false :must-revalidate true}] + (let [response (mock-middleware-response with-cache-control m)] + (is (= "max-age=3600, must-revalidate" + (get (:headers response) "Cache-Control")))))) + +(defn run-ignore-trailing-slash-paths + [route-path uri] + (let [routes (routes (GET route-path "foo")) + request {:request-method :get + :uri uri} + response ((ignore-trailing-slash routes) request)] + (= (:body response) "foo"))) + +(deftest test-ignore-trailing-slash-paths + (are (run-ignore-trailing-slash-paths _1 _2) + "/" "/" + "/foo" "/foo" + "/foo" "/foo/" + "/foo/bar" "/foo/bar/")) + +(defn run-with-context + [route-path uri context] + (let [routes (routes (GET route-path "foo")) + request {:request-method :get + :uri uri} + response ((with-context routes context) request)] + (= (:body response) "foo"))) + +(deftest test-with-context + (are (run-with-context _1 _2 "/context") + "/" "/context" + "/home" "/context/home" + "/asset/1" "/context/asset/1")) + +(deftest test-without-context + (are (not (run-with-context _1 _2 "/context")) + "/" "/" + "/home" "/home" + "/asset/1" "/asset/1")) + +(defn run-mimetypes + [uri type options] + (let [routes (routes (GET uri "foo")) + request {:request-method :get + :uri uri} + response ((with-mimetypes routes options) request) + result (get (:headers response) "Content-Type")] + (= type result))) + +(deftest test-with-default-mimetypes + (are (run-mimetypes _1 _2 {}) + "/" "text/html" + "/foobar" "text/html" + "/file.pdf" "application/pdf" + "/files/bar.css" "text/css")) + +(deftest test-with-custom-mimetypes + (let [options {:mimetypes {"foo" "test/foo" + "bar" "test/bar"} + :default "test/default"}] + (are (run-mimetypes _1 _2 options) + "/" "test/default" + "/foobar" "test/default" + "/file.pdf" "test/default" + "/file.foo" "test/foo" + "/files/file.bar" "test/bar")))
\ No newline at end of file diff --git a/compojure-3.2/test/compojure/http/request_test.clj b/compojure-3.2/test/compojure/http/request_test.clj new file mode 100755 index 0000000..5b19dc3 --- /dev/null +++ b/compojure-3.2/test/compojure/http/request_test.clj @@ -0,0 +1,51 @@ +(ns compojure.http.request-test + (:use compojure.http.request + clojure.contrib.test-is + test.helpers)) + +(deftest query-params + (are (= (parse-query-params {:query-string _1}) _2) + "a=1" {:a "1"} + "a=1&b=2" {:a "1", :b "2"})) + +(deftest query-params-plus + (is (= (parse-query-params {:query-string "a=1+2"}) + {:a "1 2"}))) + +(deftest query-params-space + (is (= (parse-query-params {:query-string "a=1%202"}) + {:a "1 2"}))) + +(deftest query-params-invalid + (are (= (parse-query-params {:query-string _1}) _2) + "" {} + "=" {} + "=1" {} + "a=1&=" {:a "1"})) + +(deftest urlencoded-charset + (is (urlencoded-form? + {:content-type "application/x-www-form-urlencoded; charset=UTF8"}))) + +(deftest form-params + (are (= (parse-form-params (form-request _1)) _2) + "a=1" {:a "1"} + "a=1&b=2" {:a "1", :b "2"})) + +(deftest assoc-params-empty + (is (= (assoc-params {}) + {:form-params {}, :query-params {}, :params {}}))) + +(deftest assoc-params-merge + (let [request {:form-params {:a "1"}, :query-params {:b "2"}}] + (is (= (assoc-params request) + (assoc request :params {:a "1", :b "2"}))))) + +(deftest assoc-params-twice + (let [request (form-request "a=1")] + (is (= (:form-params (-> request assoc-params assoc-params)) + {:a "1"})))) + +(deftest request-cookies + (is (= (parse-cookies {:headers {"cookie" "a=1;b=2"}}) + {:a "1", :b "2"}))) diff --git a/compojure-3.2/test/compojure/http/response_test.clj b/compojure-3.2/test/compojure/http/response_test.clj new file mode 100755 index 0000000..45a0d01 --- /dev/null +++ b/compojure-3.2/test/compojure/http/response_test.clj @@ -0,0 +1,46 @@ +(ns compojure.http.response-test + (:use compojure.http.response + clojure.contrib.test-is)) + +(deftest nil-response + (is (= (create-response {} nil) + {:status 200, :headers {}}))) + +(deftest int-response + (is (= (:status (create-response {} 404)) + 404))) + +(deftest next-response + (is (nil? (create-response {} :next)))) + +(deftest string-response + (is (= (:body (create-response {} "Lorem Ipsum")) + "Lorem Ipsum"))) + +(deftest seq-response + (is (= (:body (create-response {} (list "a" "b" "c"))) + (list "a" "b" "c")))) + +(deftest map-response + (let [response {:status 200 + :headers {"Content-Type" "text/plain"} + :body "Lorem Ipsum"}] + (is (= (create-response {} response) response)))) + +(deftest vector-string-response + (is (= (:body (create-response {} ["Foo" "Bar" "Baz"])) + "FooBarBaz"))) + +(deftest vector-int-response + (is (= (:status (create-response {} [200 500 403])) + 403))) + +(deftest default-content-type + (let [response {:headers {"Foo" "Bar"}}] + (is (= (:headers (update-response {} response "Foo")) + {"Foo" "Bar" "Content-Type" "text/html"})))) + +(deftest supplied-content-type + (let [response {:headers {"Content-Type" "text/plain" "Foo" "Bar"}}] + (is (= (:headers (update-response {} response "Foo")) + {"Content-Type" "text/plain" "Foo" "Bar"})))) diff --git a/compojure-3.2/test/compojure/http/routes_test.clj b/compojure-3.2/test/compojure/http/routes_test.clj new file mode 100755 index 0000000..7d9b936 --- /dev/null +++ b/compojure-3.2/test/compojure/http/routes_test.clj @@ -0,0 +1,168 @@ +(ns compojure.http.routes-test + (:use compojure.http.routes + clojure.contrib.test-is + test.helpers)) + +(deftest fixed-path + (are (match-uri (compile-uri-matcher _1) _1) + "/" + "/foo" + "/foo/bar" + "/foo/bar.html")) + +(deftest nil-paths + (is (match-uri (compile-uri-matcher "/") nil))) + +(deftest keyword-paths + (are (= (match-uri (compile-uri-matcher _1) _2) _3) + "/:x" "/foo" {:x "foo"} + "/foo/:x" "/foo/bar" {:x "bar"} + "/a/b/:c" "/a/b/c" {:c "c"} + "/:a/b/:c" "/a/b/c" {:a "a", :c "c"})) + +(deftest keywords-match-extensions + (are (= (match-uri (compile-uri-matcher _1) _2) _3) + "/foo.:ext" "/foo.txt" {:ext "txt"} + "/:x.:y" "/foo.txt" {:x "foo", :y "txt"})) + +(deftest hyphen-keywords + (are (= (match-uri (compile-uri-matcher _1) _2) _3) + "/:foo-bar" "/baz" {:foo-bar "baz"} + "/:foo-" "/baz" {:foo- "baz"})) + +(deftest urlencoded-keywords + (are (= (match-uri (compile-uri-matcher _1) _2) _3) + "/:x" "/foo%20bar" {:x "foo bar"} + "/:x" "/foo+bar" {:x "foo bar"})) + +(deftest same-keyword-many-times + (are (= (match-uri (compile-uri-matcher _1) _2) _3) + "/:x/:x/:x" "/a/b/c" {:x ["a" "b" "c"]} + "/:x/b/:x" "/a/b/c" {:x ["a" "c"]})) + +(deftest wildcard-paths + (are (= (match-uri (compile-uri-matcher _1) _2) _3) + "/*" "/foo" {:* "foo"} + "/*" "/foo.txt" {:* "foo.txt"} + "/*" "/foo/bar" {:* "foo/bar"} + "/foo/*" "/foo/bar/baz" {:* "bar/baz"} + "/a/*/d" "/a/b/c/d" {:* "b/c"})) + +(deftest url-paths + (is (match-uri (compile-uri-matcher "http://localhost") + "http://localhost"))) + +(deftest url-port-paths + (let [matcher (compile-uri-matcher "localhost:8080")] + (is (match-uri matcher "localhost:8080")) + (is (not (match-uri matcher "localhost:7070"))))) + +(deftest unmatched-paths + (is (nil? (match-uri (compile-uri-matcher "/foo") "/bar")))) + +(deftest regex-paths + (is (match-uri #"/[A-Z][a-z]" "/Ab")) + (is (not (match-uri #"/[A-Z][a-z]" "/ab")))) + +(deftest regex-path-params + (are (= (match-uri _1 _2) _3) + #"/foo/(\w+)" "/foo/bar" ["bar"] + #"/(\w+)/(\d+)" "/foo/10" ["foo" "10"])) + +(deftest assoc-route-map + (is (= (assoc-route-params {:params {}} {"foo" "bar"}) + {:route-params {"foo" "bar"}, :params {"foo" "bar"}}))) + +(deftest assoc-route-vector + (is (= (assoc-route-params {:params {}} ["foo" "bar"]) + {:route-params ["foo" "bar"], :params {}}))) + +(deftest route-response + (let [route (GET "/" "Lorem Ipsum") + request {:request-method :get, :uri "/"} + response (route request)] + (is (= response {:status 200, + :headers {"Content-Type" "text/html"}, + :body "Lorem Ipsum"})))) + +(defn- route-body + [route method uri] + (:body (route {:request-method method, :uri uri}))) + +(deftest route-methods + (are (= (route-body _1 _2 "/") _3) + (GET "/" "a") :get "a" + (POST "/" "b") :post "b" + (PUT "/" "c") :put "c" + (HEAD "/" "d") :head "d" + (DELETE "/" "e") :delete "e")) + +(deftest route-any + (are (= (route-body (ANY "/" _2) _1 "/") _2) + :get "a" + :post "b" + :put "c" + :delete "d")) + +(deftest route-var-paths + (let [path "/foo/bar"] + (is (= (route-body (GET path "pass") :get path) + "pass")))) + +(deftest route-not-match + (let [route (GET "/" "Lorem Ipsum") + request {:request-method :get, :uri "/foo"}] + (is (nil? (route request))))) + +(deftest route-match-form-method + (let [routes (routes (DELETE "/foo" "body")) + request {:request-method :post + :uri "/foo" + :content-type "application/x-www-form-urlencoded" + :body (input-stream "_method=DELETE&a=1")}] + (is (= (:status (routes request)) + 200)))) + +(deftest route-not-match-form-method + (let [routes (routes (DELETE "/foo" "body")) + request {:request-method :post + :uri "/foo" + :content-type "application/x-www-form-urlencoded" + :body (input-stream "a=1")}] + (is (nil? (routes request))))) + +(deftest route-match-form-method-not-post + (let [routes (routes (POST "/foo" "post") (DELETE "/foo" "delete")) + request {:request-method :post + :uri "/foo" + :content-type "application/x-www-form-urlencoded", + :body (input-stream "_method=DELETE&a=1")}] + (is (= (:body (routes request)) + "delete")))) + +(deftest route-keywords + (let [route (GET "/:foo" + (is (= (:route-params request) {:foo "bar"})) + "")] + (route {:request-method :get, :uri "/bar"}))) + +(deftest combine-routes + (let [r1 (fn [req] (if (= (:uri req) "/") {:body "x"})) + r2 (fn [req] {:body "y"}) + rs (routes r1 r2)] + (is (rs {:uri "/"}) "x") + (is (rs {:uri "/foo"}) "y"))) + +(deftest route-params + (let [site (routes + (GET "/:route" + (is (= (params :route) "yes")) + (is (= (params :query) "yes")) + (is (= (params :form) "yes")) + (is (request :params) params) + :next))] + (site (merge + {:request-method :get + :uri "/yes" + :query-string "query=yes"} + (form-request "form=yes"))))) diff --git a/compojure-3.2/test/compojure/http/session_test.clj b/compojure-3.2/test/compojure/http/session_test.clj new file mode 100755 index 0000000..0e30793 --- /dev/null +++ b/compojure-3.2/test/compojure/http/session_test.clj @@ -0,0 +1,73 @@ +(ns compojure.http.session-test + (:use compojure.crypto + compojure.encodings + compojure.http.session + clojure.contrib.test-is) + (:import javax.crypto.spec.IvParameterSpec + javax.crypto.spec.SecretKeySpec)) + +;; Memory sessions + +(deftest create-memory-session + (is (= (keys (create-session {:type :memory})) + [:id]))) + +(deftest memory-session-cookie + (let [repo {:type :memory} + session (create-session repo)] + (is (= (session-cookie repo true session) (session :id))) + (is (nil? (session-cookie repo false session))))) + +(deftest read-memory-session + (binding [memory-sessions (ref {::mock-id ::mock-session})] + (is (= (read-session {:type :memory} ::mock-id) + ::mock-session)))) + +(deftest write-memory-session + (binding [memory-sessions (ref {})] + (let [session (create-session {:type :memory})] + (write-session {:type :memory} session) + (is (= (memory-sessions (session :id)) + session))))) + +(deftest destroy-memory-sessions + (let [mock-session {:id ::mock-id}] + (binding [memory-sessions (ref {::mock-id mock-session})] + (destroy-session {:type :memory} mock-session) + (is (not (contains? @memory-sessions ::mock-id)))))) + +;; Cookie sessions + +(deftest create-cookie-session + (is (= (create-session {:type :cookie}) {}))) + +;; Associating session with request + +(defmethod create-session ::mock [repository] + {:id :new}) + +(defmethod read-session ::mock [repository id] + {:id :current}) + +(deftest assoc-nil-session + (let [request (assoc-session {} {:type ::mock})] + (is (:new-session? request)) + (is (= (:session request) {:id :new})))) + +(deftest assoc-expired-session + (let [session {:expires-at (timestamp-after 0)} + request (assoc-session {:session session} {:type ::mock})] + (is (:new-session? request)) + (is (= (:session request) {:id :new})))) + +(deftest assoc-existing-session + (let [cookies {:compojure-session "current"} + request (assoc-session {:cookies cookies} {:type ::mock})] + (is (not (:new-session? request))) + (is (= (:session request) {:id :current})))) + +(deftest assoc-flash-data + (let [session {:flash {:message "test"}} + request (assoc-flash {:session session})] + (is (not (contains? (request :session) :flash))) + (is (= (request :flash) {:message "test"})))) diff --git a/compojure-3.2/test/compojure/str_utils_test.clj b/compojure-3.2/test/compojure/str_utils_test.clj new file mode 100755 index 0000000..6b01bfb --- /dev/null +++ b/compojure-3.2/test/compojure/str_utils_test.clj @@ -0,0 +1,7 @@ +(ns compojure.str-utils-test + (:use compojure.str-utils + clojure.contrib.test-is)) + +(deftest test-escape + (is (= (escape "aeiou" "hello world") + "h\\ell\\o w\\orld"))) diff --git a/compojure-3.2/test/compojure/validation_test.clj b/compojure-3.2/test/compojure/validation_test.clj new file mode 100755 index 0000000..c203a81 --- /dev/null +++ b/compojure-3.2/test/compojure/validation_test.clj @@ -0,0 +1,37 @@ +(ns compojure.validation-test + (:use compojure.html.form-helpers + compojure.validation + clojure.contrib.test-is)) + +(deftest passes-validate + (is (= (validate {:a 1} :a (constantly true) "fail") + {}))) + +(deftest fails-validate + (is (= (validate {:a 1} :a (constantly false) "fail") + {:a ["fail"]}))) + +(deftest error-class-errors + (binding [*errors* {:foo "bar"}] + (is (= ((error-class text-field) :foo) + [:div.error (text-field :foo)])))) + +(deftest error-class-no-errors + (binding [*errors* {}] + (is (= ((error-class text-field) :foo) + (text-field :foo))))) + +(deftest merge-errors-test + (are (= (apply merge-errors _1) _2) + [{}] {} + [{} {} {}] {} + [{:a ["f"]}] {:a ["f"]} + [{:a ["f"]} {:b ["g"]}] {:a ["f"], :b ["g"]} + [{:a ["f"]} {:a ["g"]}] {:a ["f" "g"]})) + +(deftest validation-test + (let [params {:a 1, :b 2} + pred #(= % 2) + mesg "isn't 2"] + (is (= (validation params [:a pred mesg] [:b pred mesg]) + {:a ["isn't 2"]})))) diff --git a/compojure-3.2/test/helpers.clj b/compojure-3.2/test/helpers.clj new file mode 100755 index 0000000..9f2704b --- /dev/null +++ b/compojure-3.2/test/helpers.clj @@ -0,0 +1,14 @@ +(ns test.helpers + (:import java.io.ByteArrayInputStream) + (:import java.io.File)) + +(defn input-stream [s] + (ByteArrayInputStream. (.getBytes s))) + +(defn form-request [body] + {:content-type "application/x-www-form-urlencoded" + :body (input-stream body)}) + +(defn temp-file [] + (doto (File/createTempFile "compojure" "test") + (.deleteOnExit))) diff --git a/compojure-3.2/test/run.clj b/compojure-3.2/test/run.clj new file mode 100755 index 0000000..a651691 --- /dev/null +++ b/compojure-3.2/test/run.clj @@ -0,0 +1,17 @@ +(use 'clojure.contrib.find-namespaces + 'clojure.test) + +(defn find-tests [] + (filter + #(re-find #"-test" (str %)) (find-namespaces-in-dir (java.io.File. "test")))) + +(defn require-tests [] + (doseq [test (find-tests)] + (require test))) + +(require-tests) +(let [results (apply merge-with + (map test-ns (find-tests)))] + (if (or (> (results :fail) 0) + (> (results :error) 0)) + (System/exit -1) + (System/exit 0))) diff --git a/lib/README.txt b/lib/README.txt new file mode 100755 index 0000000..b796f78 --- /dev/null +++ b/lib/README.txt @@ -0,0 +1 @@ +NOTE: compojure-3.2v1 contains a custom fix to the MIME-type guessing function extension.
\ No newline at end of file diff --git a/lib/compojure-3.2v1.jar b/lib/compojure-3.2v1.jar Binary files differnew file mode 100755 index 0000000..c41f5e9 --- /dev/null +++ b/lib/compojure-3.2v1.jar diff --git a/lib/compojure-back.jar b/lib/compojure-back.jar Binary files differnew file mode 100755 index 0000000..c41f5e9 --- /dev/null +++ b/lib/compojure-back.jar diff --git a/lib/compojureold.jar b/lib/compojureold.jar Binary files differdeleted file mode 100755 index 8d3dd11..0000000 --- a/lib/compojureold.jar +++ /dev/null |