]> gitweb.factorcode.org Git - factor.git/blob - extra/cgi/cgi.factor
Fixes #2966
[factor.git] / extra / cgi / cgi.factor
1 ! Copyright (C) 2009-2012 John Benediktsson
2 ! See http://factorcode.org/license.txt for BSD license
3
4 USING: arrays assocs combinators environment io kernel
5 linked-assocs math.parser regexp sequences splitting strings
6 unicode urls.encoding ;
7
8 IN: cgi
9
10 <PRIVATE
11
12 : query-string ( string -- assoc )
13     query>assoc [ nip ] assoc-filter [
14         [ [ CHAR: \s = ] trim ]
15         [ dup string? [ 1array ] when ] bi*
16     ] assoc-map ;
17
18 : parse-get ( -- assoc )
19     "QUERY_STRING" os-env "" or query-string ;
20
21 : content-type ( string -- params media/type )
22     ";" split unclip [
23         [ LH{ } clone ] [ first query-string ] if-empty
24     ] dip ;
25
26 : multipart ( -- assoc )
27     "multipart unsupported" throw ;
28
29 : urlencoded ( -- assoc )
30     "CONTENT_LENGTH" os-env [ string>number ] [ 0 ] if*
31     read [ "" ] [ "&" append ] if-empty
32     "QUERY_STRING" os-env [ append ] when* query-string ;
33
34 : parse-post ( -- assoc )
35     "CONTENT_TYPE" os-env "" or content-type {
36        { "multipart/form-data"               [ multipart ] }
37        { "application/x-www-form-urlencoded" [ urlencoded ] }
38        [ drop parse-get ]
39    } case nip ;
40
41 PRIVATE>
42
43 : <cgi-form> ( -- assoc )
44     "REQUEST_METHOD" os-env "GET" or >upper {
45         { "GET"  [ parse-get ] }
46         { "POST" [ parse-post ] }
47         [ "Unknown request method" throw ]
48     } case ;
49
50 : <cgi-simple-form> ( -- assoc )
51     <cgi-form> [ first ] assoc-map ;