From: pho <pho@cielonegro.org>
Date: Thu, 19 Apr 2007 14:36:50 +0000 (+0900)
Subject: Added inputForm
X-Git-Tag: RELEASE-0_2_1~52
X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=commitdiff_plain;h=62f7c13cae3dd68e639b279a3c9a9a742a559927

Added inputForm

darcs-hash:20070419143650-62b54-7660db0cba66f4ec3c32956538fa013bd97b0d7a.gz
---

diff --git a/Network/HTTP/Lucu/Resource.hs b/Network/HTTP/Lucu/Resource.hs
index 7b1b26a..d01fd1c 100644
--- a/Network/HTTP/Lucu/Resource.hs
+++ b/Network/HTTP/Lucu/Resource.hs
@@ -21,6 +21,7 @@ module Network.HTTP.Lucu.Resource
     , inputChunk   -- Int -> Resource String
     , inputBS      -- Int -> Resource ByteString
     , inputChunkBS -- Int -> Resource ByteString
+    , inputForm    -- Int -> Resource [(String, String)]
     , defaultLimit -- Int
 
     , setStatus -- StatusCode -> Resource ()
@@ -358,6 +359,35 @@ inputChunkBS limit
                return chunk
 
 
+-- application/x-www-form-urlencoded または multipart/form-data をパー
+-- スする。もし Content-Type が無かったら BadRequest で終了し、未對應の
+-- タイプであったら UnsupportedMediaType で終了する。
+inputForm :: Int -> Resource [(String, String)]
+inputForm limit
+    = do cTypeM <- getContentType
+         case cTypeM of
+           Nothing
+               -> abort BadRequest [] (Just "Missing Content-Type")
+           Just (MIMEType "application" "x-www-form-urlencoded" _)
+               -> readWWWFormURLEncoded
+           Just (MIMEType "multipart" "form-data" _)
+               -> readMultipartFormData
+           Just cType
+               -> abort UnsupportedMediaType [] (Just $ "Unsupported media type: "
+                                                          ++ show cType)
+    where
+      readWWWFormURLEncoded
+          = do src <- input limit
+               return $ do pairStr <- splitBy (\ c -> c == ';' || c == '&') src
+                           let pair = break (== '=') pairStr
+                           return ( unEscapeString $ fst pair
+                                  , unEscapeString $ snd pair
+                                  )
+      readMultipartFormData -- FIXME: 未對應
+          = abort UnsupportedMediaType []
+            (Just $ "Sorry, inputForm does not currently support multipart/form-data.")
+
+
 defaultLimit :: Int
 defaultLimit = (-1)