diff --git a/.gitignore b/.gitignore
index ffc495c..998d543 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,3 +1,4 @@
-target
*~
\#*#
+classes
+lib/
diff --git a/pom.xml b/pom.xml
deleted file mode 100644
index 05320be..0000000
--- a/pom.xml
+++ /dev/null
@@ -1,106 +0,0 @@
-
- 4.0.0
- de.fnogol
- compojure-rest
- 0.1-SNAPSHOT
-
-
-
- org.clojure
- clojure
- 1.0.0
-
-
- org.clojure
- clojure-contrib
- 1.0-SNAPSHOT
-
-
- org.compojure
- compojure
- 0.3.1-SNAPSHOT
-
-
- org.mortbay.jetty
- jetty
- 6.1.21
-
-
- commons-codec
- commons-codec
- 1.4
-
-
- commons-fileupload
- commons-fileupload
- 1.2.1
-
-
- commons-io
- commons-io
- 1.4
-
-
-
-
-
-
-
-
-
- jline
- jline
- 0.9.94
-
-
- com.codestuffs.clojure
- swank-clojure
- 1.0-SNAPSHOT
-
-
-
-
-
- com.theoryinpractise
- clojure-maven-plugin
-
-
-
-
- compile-clojure
- compile
-
- compile
-
-
-
-
-
-
-
-
diff --git a/project.clj b/project.clj
new file mode 100644
index 0000000..b0d3b38
--- /dev/null
+++ b/project.clj
@@ -0,0 +1,11 @@
+(defproject compojure-rest "0.0.1-SNAPSHOT"
+ :dependencies [[org.clojure/clojure "1.1.0-alpha-SNAPSHOT"]
+ [org.clojure/clojure-contrib "1.0-SNAPSHOT"]
+ [org.clojars.ato/compojure "0.3.1"]
+ [org.mortbay.jetty/jetty "6.1.21"]
+ [commons-codec/commons-codec "1.4"]
+ [commons-fileupload/commons-fileupload "1.2.1"]
+ [commons-io/commons-io "1.4"]
+ ]
+ :dev-dependencies [[org.clojure/swank-clojure "1.0"]
+ [lein-clojars "0.5.0-SNAPSHOT"]])
diff --git a/src/main/clojure/compojure_rest.clj b/src/compojure_rest.clj
similarity index 86%
rename from src/main/clojure/compojure_rest.clj
rename to src/compojure_rest.clj
index 07c50c2..e77a719 100644
--- a/src/main/clojure/compojure_rest.clj
+++ b/src/compojure_rest.clj
@@ -11,6 +11,7 @@
(:use compojure.http.response)
(:use clojure.contrib.core)
(:import java.util.Date)
+ (:import java.util.TimeZone)
(:import java.lang.System)
(:import java.util.Locale)
(:import java.text.SimpleDateFormat))
@@ -20,16 +21,26 @@
(function-or-value request)
function-or-value))
-(def *http-date-format*
- (new SimpleDateFormat
- "EEE, dd MMM yyyy HH:mm:ss Z"
- Locale/US))
+(def *http-date-format* "EEE, dd MMM yyyy HH:mm:ss Z")
-(defn http-date [int-or-date]
- (if-let [date (if (integer? int-or-date)
- (new Date (+ int-or-date (System/currentTimeMillis)))
- int-or-date)]
- (.format *http-date-format* date)))
+(defmulti -get-timezone (fn [x] (type x)))
+(defmethod -get-timezone String [tz] (TimeZone/getTimeZone tz))
+(defmethod -get-timezone TimeZone [tz] tz)
+
+(defn http-date-format
+ ([] (http-date-format (TimeZone/getDefault)))
+ ([tz] (let [df (new SimpleDateFormat
+ *http-date-format*
+ Locale/US)]
+ (do (.setTimeZone df (-get-timezone tz))
+ df))))
+
+(defn relative-date [int]
+ (new Date (+ int (System/currentTimeMillis))))
+
+(defn http-date
+ ([date] (.format (http-date-format) date))
+ ([date timezone] (.format (http-date-format timezone) date)))
(defn wrap-header [handler header generate-header]
(fn [request]
diff --git a/src/compojure_rest/resource.clj b/src/compojure_rest/resource.clj
new file mode 100644
index 0000000..40a10e1
--- /dev/null
+++ b/src/compojure_rest/resource.clj
@@ -0,0 +1,214 @@
+;; Copyright (c) Philipp Meier (meier@fnogol.de). 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-rest.resource
+ (:use compojure)
+ (:use compojure.http.response)
+ (:use compojure-rest)
+ (:use clojure.contrib.core)
+ (:use clojure.contrib.trace)
+ (:import clojure.lang.Fn)
+ (:import java.util.Date)
+ (:import java.util.Map)
+ (:import java.lang.System)
+ (:import java.util.Locale)
+ (:import java.text.SimpleDateFormat))
+
+
+(def *default-functions*
+ {
+ :service-available true
+ :uri-too-long false
+ :known-method (fn [req] (#(some #{(:request-method req)}
+ [:get :head :options
+ :put :post :delete :trace])))
+ :method-allowed (fn [req] (#(some #{(:request-method req)}
+ [:get :head])))
+ :malformed false
+ :authorized true
+ :allowed true
+ :known-content-type true
+ :valid-content-header true
+ :valid-entity-length true
+ :options {}
+ :content-types-provided "text/html"
+ :languages-provided "*"
+ :encodings-provided "*"
+ :charsets-provided "*"
+ :get ""
+ :exists true
+ })
+
+(defn simple-negotiate [provided accept-header]
+ (let [provided-l (if (coll? provided) provided [provided]) ]
+ (if (or (.contains accept-header "*/*")
+ (= accept-header "*"))
+ (first provided-l)
+ (if (some #{"*"} provided-l)
+ accept-header
+ (#(some #{accept-header} provided-l))))))
+
+(defn wrap-options [handler generate-options-header]
+ (fn [request]
+ (if (= :options (request :request-method))
+ { :headers (evaluate-generate generate-options-header request)}
+ (handler request))))
+
+(defn wrap-accept-header [handler provider-function negotiate-function header neg-key default]
+ (fn [request]
+ (let [accept ((request :headers {}) header default)
+ provided (evaluate-generate provider-function request)]
+ (if-let [neg (negotiate-function provided accept)]
+ (handler (assoc-in request [::rest neg-key] neg))
+ {:statuc 406 :body (str header " " accept " cannot be provided. Available is " provided)}))
+ ))
+
+(defn wrap-accept [handler content-types-provided]
+ (wrap-accept-header handler content-types-provided simple-negotiate
+ "Accept" :neg-content-type "*/*"))
+
+(defn wrap-accept-language [handler provider-function]
+ (wrap-accept-header handler provider-function simple-negotiate
+ "Accept-Language" :neg-lang "*"))
+
+(defn wrap-accept-charset [handler provider-function]
+ (wrap-accept-header handler provider-function simple-negotiate
+ "Accept-Charset" :neg-charset "*"))
+
+(defn wrap-accept-encoding [handler provider-function]
+ (wrap-accept-header handler provider-function simple-negotiate
+ "Accept-Encoding" :neg-encoding "*"))
+
+(defn send-response [response]
+ response)
+
+(defn handle-missing-resource [request]
+ {:status 404 :body "Missing resource not implemented."})
+
+(defn handle-delete [m request]
+ (send-response (m :delete)))
+
+(defn accept-entity [m request]
+ (let [content-type ((request :header) "Content-Type" "application/octet-stream")]
+ (comment ;; Todo: search (m :accept-content-type-handlers)
+ )))
+
+(defn assert-valid-redirect [resp]
+ (if (and (= (resp :status) 303) (not (-> resp :header "Location")))
+ { :status 500 :body "Response was redirect but no location." }
+ resp))
+
+(defn handle-post-and-redirect [m request]
+ (assert-valid-redirect
+ (if ((m :post-is-create) request)
+ (let [new-path ((m :create-path) request)
+ request (assoc request :path new-path)]
+ (accept-entity m request))
+ ((m :process-post) request))))
+
+
+
+(defn handle-post [m request]
+ (if (evaluate-generate (m :allow-missing-post) request)
+ (handle-post-and-redirect m request)
+ 404))
+
+(defn handle-put [m request]
+ (if ((m :is-conflict) request)
+ 409
+ (accept-entity m request)))
+
+(defmulti evaluate-body
+ "Evaluate the generator with the current request. The type of the
+ generator determines how it is evaluated"
+ (fn [generator request]
+ (class generator)))
+
+(defmethod evaluate-body Fn
+ [update request]
+ (update request))
+
+(defmethod evaluate-body Map
+ [content-type-map request]
+ (let [content-type (-> request ::rest :neg-content-type)]
+ (if-let [generator (content-type-map content-type)]
+ (generator request)
+ {:status 500
+ :body (str "No body generation function found for negotiated content type \""
+ content-type "\" request is " request)})))
+
+(defmethod evaluate-body String
+ [body request]
+ body)
+
+(defn check-multiple [m request]
+(trace "c-m" (if (m :multiple-choices?)
+ 300
+ (if (= :get (request :request-method))
+ (evaluate-body (m :get) request)
+ ""))))
+
+
+(defn handle-get-head [m request]
+ (trace "handle-get-head"
+ (let [resp (trace "ETag"
+ (if-let [etag (evaluate-generate (m :generate-etag) request)]
+ {:headers { "Etag" etag } } {}))
+ resp (trace "Last-M"
+ (if-let [lm (evaluate-generate (m :last-modified) request)]
+ (assoc-in resp [:headers "Last-Modified"] lm) resp))
+ resp (trace "Exp" (if-let [exp (evaluate-generate (m :expires) request)]
+ (assoc-in resp [:headers "Expires"] exp) resp))]
+ (update-response request resp (check-multiple m request)))))
+
+
+
+(defn handle-delete-put-post [m]
+ (fn [request]
+ (condp = (request :request-method)
+ :delete (handle-delete m request)
+ :post (handle-post m request)
+ :put (handle-put m request)
+ (handle-get-head m request))))
+
+(defn wrap-log [handler]
+ (fn [request]
+ (do (prn (str "Calling " handler " with request " request))
+ (let [resp (handler request)]
+ (prn (str "<- " handler " result " resp))))))
+
+
+;; handlers must be a map of implementation methods
+(defn resource [ & kvs]
+ (fn [request]
+ (let [m (merge *default-functions* (apply hash-map kvs))]
+ ((->
+ (handle-delete-put-post m)
+ (wrap-if-modified-since (m :last-modified))
+ (wrap-if-none-match (m :generate-etag))
+ (wrap-if-unmodified-since (m :last-modified))
+ (wrap-if-match (m :generate-etag))
+ (wrap-predicate (m :exists) handle-missing-resource)
+ (wrap-accept-encoding (m :encodings-provided))
+ (wrap-accept-charset (m :charsets-provided))
+ (wrap-accept-language (m :languages-provided))
+ (wrap-accept (m :content-types-provided))
+ (wrap-options (m :options))
+ (wrap-predicate (m :valid-entity-length) 413)
+ (wrap-predicate (m :known-content-type) 415)
+ (wrap-predicate (m :valid-content-header) 501)
+ (wrap-allow (m :allowed))
+ (wrap-auth (m :authorized))
+ (wrap-predicate #(comp not (evaluate-generate (m :malformed) %)) 400)
+ (wrap-predicate (m :method-allowed) 405)
+ (wrap-predicate #(comp not (evaluate-generate (m :uri-too-long) %)) 414)
+ (wrap-predicate (m :known-method) 501)
+ (wrap-predicate (m :service-available) 503))
+ request))))
+
+
diff --git a/test/test.clj b/test/test.clj
new file mode 100644
index 0000000..802aae8
--- /dev/null
+++ b/test/test.clj
@@ -0,0 +1,57 @@
+;; Copyright (c) Philipp Meier (meier@fnogol.de). 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 test
+ (:use compojure)
+ (:use compojure-rest)
+ (:use compojure-rest.resource))
+
+(defn hello-resource [request]
+ ((-> (method-not-allowed)
+ (wrap-generate-body (fn [r] (str "Hello " ((request :params) :who "stranger"))))
+ (wrap-etag (comp :who :params))
+ (wrap-expiry (constantly 10000))
+ (wrap-last-modified -1000)
+ (wrap-exists (comp not #(some #{%} ["cat"]) :who :params))
+ (wrap-auth (comp not #(some #{%} ["evil"]) :who :params))
+ (wrap-allow (comp not #(some #{%} ["scott"]) :who :params)))
+ request))
+
+
+
+(def product-resource
+ (resource
+ :content-types-provided [ "text/html", "text/plain"]
+ :exists (fn [req] (if-let [id (-> req :route-params :id)]
+ (if (< id 10)
+ (assoc req ::product (str "P-" id)))))
+ :generate-etag (fn [req] (str "X-" (req ::product)))
+ :delete (fn [req] "deleted")
+ :put (fn [req] (str "PUT: "
+ ((req :route-params) :id) (req :body)))
+ :get {
+ "text/html" (fn [req] (str "
" (req ::product) "
"))
+ :json (fn [req] (str "JSON: " (req ::product)))
+ :xml (fn [req] (str "XML:" (req ::product)))}))
+
+
+
+
+(defroutes my-app
+ (ANY "/hello/:who" hello-resource)
+ (ANY "/product/:id" product-resource)
+ (GET "/simple" (str "simple"))
+ (GET "/echo/:foo" (fn [req] {:headers { "Content-Type" "text/plain" } :body (str (dissoc req :servlet-request))}))
+ (GET "*" (page-not-found)))
+
+(defn main []
+ (do
+ (defserver test-server {:port 8080} "/*" (servlet my-app))
+ (start test-server)))
+
+