set cgi_argl ""
set cgi_argl_read 0
set cgi_input ""
proc get_cgi_args {} {
global env argv cgi_input
if {! [info exists env(REQUEST_METHOD)] } {
set cgi_input [join $argv "&"]
} elseif {"$env(REQUEST_METHOD)"=="GET"} {
set cgi_input $env(QUERY_STRING)
} else {
set cgi_input [string trim [ gets stdin ]]
}
return $cgi_input
}
proc split_cgi_args s {
set argl [split $s "&"]
foreach i $argl {
lappend rl [decode_cgi_args $i]
}
if [info exists rl] {
return $rl
} else {
return ""
}
}
proc decode_cgi_args s {
set argl [split $s "="]
foreach i $argl {
lappend rl [trans_cgi_str $i]
}
if {[llength $rl]==1} {
lappend $rl {}
}
return $rl
}
proc trans_cgi_str str {
regsub -all -- {\+} $str " " str
regsub -all -- {%0D%0A} $str {\n} str
regsub -all -- {%2F} $str {/} str
regsub -all -- {%(..)} $str {[subst \x\1]} str
return [subst -novariables $str]
}
proc get_cgi_argl {} {
global cgi_argl cgi_argl_read
if {! $cgi_argl_read} {
set cgi_argl [split_cgi_args [get_cgi_args]]
set cgi_argl_read 1
}
return $cgi_argl
}
proc get_cgi_arg {name {default {}}} {
foreach pair [get_cgi_argl] {
if {"[lindex $pair 0]"=="$name"} {
lappend rl [lindex $pair 1]
}
}
if [info exist rl] {
return $rl
} else {
return $default
}
}
proc get_cgi_arg_text {name {default {}}} {
set r [string trim [join [get_cgi_arg $name $default]]]
if {"$r"==""} {
return $default
} else {
return $r
}
}
proc get_cgi_input {} {
global cgi_input
get_cgi_argl
return $cgi_input
}
