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.case 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 ;