Posted to tcl by rmax at Thu Jul 25 09:55:36 GMT 2013view raw
- 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
- }