#
# ProcCGIInput.tcl by Frank Pilhofer fp@informatik.uni-frankfurt.de
#
# Process CGI Input data in Tcl. Handle all means of possible input to
# a CGI script (POST, GET, URL-encoding) and output everything into the
# form() array.
#
# Source this file!
#

proc ProcCGIInput { {list {}} } {
    global env form argv

    if { [catch {set env(REQUEST_METHOD)}] } {set env(REQUEST_METHOD) ""}
    if { [catch {set env(QUERY_STRING)}] }   {set env(QUERY_STRING) ""}
    if { [catch {set env(PATH_INFO)}] }      {set env(PATH_INFO) ""}

    if { "$env(REQUEST_METHOD)" == "POST" } {
	set _F_QueryString "[read stdin $env(CONTENT_LENGTH)]&"
    } else {
	set _F_QueryString "$env(QUERY_STRING)&"
    }
    foreach _F_par $argv {
	append _F_QueryString "$_F_par&"
    }
    foreach _F_par [split $env(PATH_INFO) "/"] {
	append _F_QueryString "$_F_par&"
    }
    #
    # process data
    #
    foreach _F_par [split $_F_QueryString "&"] {
	set _F_data [split $_F_par "="]
	set _F_var  [lindex $_F_data 0]
	set _F_val  [join [lrange $_F_data 1 end] "="]
	
	if { $_F_var == "" } {
	    continue
	}
	#
	# replace + by spaces
	#
	regsub -all {\+} $_F_val " " _F_val
	regsub -all {\+} $_F_var " " _F_var
	#
	# replace %XX by ascii character
	#
	while {[regexp -nocase {%([0-9a-f][0-9a-f])} $_F_val matsch hex]} {
	    set oct [eval format "%03o" 0x$hex]
	    eval regsub -all \{$matsch\} \{$_F_val\} "\\$oct" _F_val
	}
	while {[regexp -nocase {%([0-9a-f][0-9a-f])} $_F_var matsch hex]} {
	    set oct [eval format "%03o" 0x$hex]
	    eval regsub -all \{$matsch\} \{$_F_var\} "\\$oct" _F_var
	}
	#
	# okay
	#
	if [catch {set form($_F_var)}] {
	    set form($_F_var) $_F_val
	} else {
	    append form($_F_var) ":$_F_val"
	}
    }
    #
    # for each variable in list, set $form(var) to "", so that
    # this variable does at least exist and $form(var) does not
    # fail
    #
    foreach _F_var $list {
	if { [catch {set form($_F_var)}] } {
	    set form($_F_var) ""
	}
    }
}