Route matching for the Sinatra PUT/DELETE form _method trick used by …

…form-to.

Signed-off-by: James Reeves <jreeves@weavejester.com>

src/compojure/html/form_helpers.clj

@@ -125,12 +125,12 @@
   e.g. (form-to [:put \"/post\"]
          ...)"
   [[method action] & body]
-  (let [method-str (. (name method) toUpperCase)]
+  (let [method-str (upcase-name method)]
     (into []
       (concat
         (if (includes? [:get :post] method)
           [:form {:method method-str :action action}]
-          [:form {:method "POST" :action action} 
+          [:form {:method "POST" :action action}
            (hidden-field "_method" method-str)])
         body))))
 

src/compojure/http/routes.clj

@@ -121,12 +121,25 @@
         (subvec matches 1)
         []))))
 
-(defn match-method
+(defn match-route-method
   "True if the method from the route matches the method from the request."
   [route-method request-method]
   (or (nil? route-method)
       (= route-method request-method)))
 
+(defn match-form-method
+  "True if the route-method matches a posted forms _method parameter."
+  [route-method request]
+  (and (= (request :request-method) :post)
+       (= (:_method (get-form-params request))
+          (upcase-name route-method))))
+
+(defn match-method
+  "True if this request matches the route-method."
+  [route-method request]
+  (or (match-route-method route-method (request :request-method))
+      (match-form-method route-method request)))
+
 (defn request-url
   "Return the complete URL for the request."
   [request]
@@ -158,7 +171,7 @@
                  `(compile-matcher ~path))]
    `(fn [request#]
       (and
-        (match-method ~method (request# :request-method))
+        (match-method ~method request#)
         (match-uri ~matcher (get-matcher-uri ~path request#))))))
 
 ;; Functions and macros for generating routing functions. A routing function

src/compojure/str_utils.clj

@@ -80,3 +80,8 @@
   "Generate a random UUID."
   []
   (str (UUID/randomUUID)))
+
+(defn upcase-name
+  "Upcase a symbol or keyword's name."
+  [sym]
+  (. (name sym) toUpperCase))

test/compojure/http/routes.clj

@@ -101,6 +101,20 @@
         request {:request-method :get, :uri "/foo"}]
     (is (nil? (route request)))))
 
+(deftest route-match-form-method
+  (let [route   (DELETE "/foo" "body")
+        request {:request-method :post,
+                 :uri "/foo",
+                 :content-type "application/x-www-form-urlencoded"
+                 :form-params {:_method "DELETE"}}]
+    (is (= (:status (route request) 200)))))
+
+(deftest route-not-match-form-method
+  (let [route   (DELETE "/foo" "body")
+        request {:request-method :post,
+                 :uri "/foo" }]
+    (is (nil? (route request)))))
+
 (deftest route-keywords
   (let [route (GET "/:foo"
                 (is (= (:route-params request) {:foo "bar"}))