#
# Unterprogramme für CGI-Skripte in tcl
#
# Rainer Maurer, 1996
# Vorarbeit von Henner Zeller, 1995
# Globale Variable QUERYSTRING von Frederik Holst, 1997

proc CGI_Parameter {{args {}}} {
    # PARAMETER: Liste der CGI-Parameter
    # IST_LISTE: Array mit Parametern als Elementen:
    #            0 - Parameter ist keine Liste
    #            1 - Parameter ist eine Liste
    global PARAMETER IST_LISTE env QUERYSTRING
    if [info exists env(REQUEST_METHOD)] {
        if {$env(REQUEST_METHOD)!="POST"} {
            # GET...
            set query $env(QUERY_STRING)
        } else {
            # POST...
            set query [read stdin $env(CONTENT_LENGTH)]
            set QUERYSTRING $query
        }    
    }

    proc wandle {str} {
        # Ersetzungen durch den Client rückgängig machen:
        # Leerzeichen wurden durch + ersetzt:
        regsub -all {\+} $str " " str
        # In str Hexzahlen rückwandeln
        # Zeilenumbrüche wurden durch %0D%0A ersetzt:
        regsub -all {%0[dD]%0[aA]} $str "\n" str
        # Sonderfall & wegen Sonderbedeutung in regsub:
        regsub -all "%26" $str \\& str
        # sonstige Hexzahlen rückwandeln:
        while {[regexp {%([0-9a-fA-F][0-9a-fA-F])} $str dummy hexzahl]} {
            regsub "%$hexzahl" $str [format "%c" "0x$hexzahl"] str
        }
        return $str
    }
    # Extrahieren der einzelnen Variablen:
    while {[regexp {([^&]+)=([^&]*)} $query alles vname vwert]} {
        set vname [wandle $vname]
        set vwert [wandle $vwert]
        global $vname
        if [info exists $vname] {
            if $IST_LISTE($vname) {
                lappend $vname $vwert
            } else {
                set IST_LISTE($vname) 1
                set $vname [list $vname $vwert]
            }
        } else {
            set $vname $vwert
            set IST_LISTE($vname) 0
            lappend PARAMETER $vname
        }
        # extrahiertes Paar entfernen:
        regsub {([^&]+)=([^&]*)} $query "" query
    }
    # Übergebene Variablen erzeugen, falls nicht enthalten:
    foreach el $args {
        if {![info exists $el]} {
            global $el
            set IST_LISTE($el) 0
            set $el ""
        }
    }
}

proc HTTP_Header {{args {}}} {
    # Schreibt "Content-Type: text/html" und "" and stdout.
    # optionale Parameter werden als HTTP-Header ausgegeben.
    puts "Content-Type: text/html"
    foreach el $args {
	puts $el
    }
    puts ""
}