#!/lusr/bin/tclsh

# Set up useful global variables.

proc parse {} {
    global env
    if {$env(REQUEST_METHOD) == "GET"} {
	global GET
	set GET $env(QUERY_STRING)
    } elseif {$env(REQUEST_METHOD) == "POST"} {
	global POST
	# parse out the post string.
	set str [read stdin $env(CONTENT_LENGTH)]
	set items [split $str &]
	foreach n $items {
	    # backslash everything as appropriate.
	    regsub -all {(\[|\]|\{|\}|\"|\$)} $n {\\\1} n
	    # convert pluses into spaces.
	    regsub -all {\+} $n " " n
	    # convert %XX from hex to ASCII and unbackslash.
	    regsub -all {%(..)} $n {[scan "%x" \1 d ; return [format "%c" $d]]} dummy
	    set n [subst $n]
	    # break into key/val pairs.
	    set kl [split $n =]
	    set key [lindex $kl 0]
	    set val [lindex $kl 1]
	    # append or store value.
	    if {[info exists POST($key)]} {
		set POST($key) "$POST($key)\0$val"
	    } else {
		set POST($key) $val
	    }
	}
    }

    global MY_URL
    if {$env(SERVER_PORT) != 80} {
	set port ":$env(SERVER_PORT)"
    } else {
	set port ""
    }
    set MY_URL "http://$env(SERVER_NAME)$port$env(SCRIPT_NAME)"

}


parse

# Read in the program.
set program_in [read stdin]

# Trash all comments
# (<! and zero or more any "comments" (starting and ending with --) then >)

regsub -all {<!(--([^-]*|[^-]*-[^-]*)--[\ \t\n]*)*>} $program_in "" program

# Replace all text bracketed by <: ... :> with
# its value (evaluated in Tcl).

set more_code 1
while {$more_code} {
    set more_code [regexp -indices {<:([^:]*):>} $program whole_match match]
    if {$more_code} {
	set code [string range $program [lindex $match 0] [lindex $match 1]]
	puts -nonewline [string range $program 0 [expr [lindex $whole_match 0]-1]]
	puts [eval $code]
	set program [string range $program [expr [lindex $whole_match 1]+1] end]
    }
}

# Output whatever is left, and we are out of here.

puts $program

