Posted to tcl by rmax at Thu Jul 25 09:55:36 GMT 2013view pretty

proc GET {args} {
    global cookies headers
    # puts "GET [lindex $args 0]"
    lappend args -headers [array get headers]
    set headers(Referer) [regexp -inline {^[^?]+} [lindex $args 0]]
    # puts $args
    set t [eval [linsert $args 0 http::geturl]]
    upvar "#0" $t state
    foreach {key value} $state(meta) {
        switch -- $key {
            Set-Cookie {
                # puts "$key: $value"
                array set cookies [split [lindex [split $value ";"] 0] =]
            }
            Location {
                set location $value
            }
        }
    }
    set c [list]
    foreach {name value} [array get cookies] {
        lappend c $name=$value
    }
    set headers(Cookie) [join $c "; "]

    switch -- [http::ncode $t] {
        200 {
            set data [http::data $t]
        }
        302 {
            if {![regexp {://} $location]} {
                set url [lindex $args 0]
                regsub {/[^/]*$} $url /$location location
            }
            # puts "Redirect: $location"
            set data [GET $location]
        }
        default {
            puts [http::code $t]
            puts [http::error $t]
            puts [http::data $t]
            exit
        }
    }
    http::cleanup $t
    return $data
}