Posted to tcl by patthoyts at Fri Aug 04 14:00:14 GMT 2006view pretty
proc get_url {url} { global env set data {} array set parts [uri::split $url file] if {[string equal "file" $parts(scheme)]} { set path [file normalize $parts(path)] set f [open $path r] set data [read $f] close $f } elseif {[string equal "http" $parts(scheme)]} { set tmp /tmp if {[info exists env(TEMP)]} { set tmp $env(TEMP) } if {[file isdirectory $tmp]} { set tmpname [file join $tmp [file tail $parts(path)]] if {[file exists $tmpname]} { set f [open $tmpname r] set data [read $f] close $f return $data } } set tok [http::geturl $url -timeout 30000] if {[string equal [http::status $tok] "ok"]} { set data [http::data $tok] http::cleanup $tok if {[file isdirectory $tmp]} { set f [open [file join $tmp [file tail $parts(path)]] w] puts -nonewline $f $data close $f } } else { set err [http::error $tok] http::cleanup $tok return -code error $err } } else { return -code error "scheme \"$parts(scheme)\" not supported" } return $data }