--- /dev/null
+! Copyright (C) 2009-2012 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+USING: assocs help.markup help.syntax ;
+IN: cgi
+
+HELP: <cgi-form>
+{ $values { "assoc" assoc } }
+{ $description "Parse a CGI request into an " { $link assoc } ". Multiple parameters are passed as a list for each key." } ;
+
+HELP: <cgi-simple-form>
+{ $values { "assoc" assoc } }
+{ $description "Parse a CGI request into an " { $link assoc } ". Only the first parameter is kept, if multiple parameters are passed." } ;
--- /dev/null
+! Copyright (C) 2009 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: cgi cgi.private kernel tools.test ;
+
+[ t ] [ H{ } "" (query-string) = ] unit-test
+
+[ t ] [ H{ { "a" { "1" } } { "b" { "2" } } }
+ "a=1&b=2" (query-string) = ] unit-test
+
+[ t ] [ H{ { "a" { "1" } } { "b" { "2" "3" } } }
+ "a=1&b=2&b=3" (query-string) = ] unit-test
+
+[ t ] [ "text/html" (content-type)
+ [ H{ } = ] [ "text/html" = ] bi* and ] unit-test
+
+[ t ] [ "text/html; charset=utf-8" (content-type)
+ [ H{ { "charset" { "utf-8" } } } = ]
+ [ "text/html" = ] bi* and ] unit-test
+
--- /dev/null
+! Copyright (C) 2009-2012 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: arrays assocs combinators environment io kernel
+math.parser regexp sequences splitting strings unicode.case
+urls.encoding ;
+
+IN: cgi
+
+<PRIVATE
+
+: (query-string) ( string -- assoc )
+ query>assoc [ nip ] assoc-filter [
+ [ [ CHAR: \s = ] trim ]
+ [ dup string? [ 1array ] when ] bi*
+ ] assoc-map ;
+
+: parse-get ( -- assoc )
+ "QUERY_STRING" os-env "" or (query-string) ;
+
+: (content-type) ( string -- params media/type )
+ ";" split unclip [
+ [ H{ } clone ] [ first (query-string) ] if-empty
+ ] dip ;
+
+: (multipart) ( -- assoc )
+ "multipart unsupported" throw ;
+
+: (urlencoded) ( -- assoc )
+ "CONTENT_LENGTH" os-env "0" or string>number
+ read [ "" ] [ "&" append ] if-empty
+ "QUERY_STRING" os-env [ append ] when* (query-string) ;
+
+: parse-post ( -- assoc )
+ "CONTENT_TYPE" os-env "" or (content-type) {
+ { "multipart/form-data" [ (multipart) ] }
+ { "application/x-www-form-urlencoded" [ (urlencoded) ] }
+ [ drop parse-get ]
+ } case nip ;
+
+PRIVATE>
+
+: <cgi-form> ( -- assoc )
+ "REQUEST_METHOD" os-env "GET" or >upper {
+ { "GET" [ parse-get ] }
+ { "POST" [ parse-post ] }
+ [ "Unknown request method" throw ]
+ } case ;
+
+: <cgi-simple-form> ( -- assoc )
+ <cgi-form> [ first ] assoc-map ;
+
+