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
}