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 }