Posted to tcl by patthoyts at Fri Aug 04 14:00:14 GMT 2006view raw

  1. proc get_url {url} {
  2. global env
  3. set data {}
  4. array set parts [uri::split $url file]
  5. if {[string equal "file" $parts(scheme)]} {
  6. set path [file normalize $parts(path)]
  7. set f [open $path r]
  8. set data [read $f]
  9. close $f
  10. } elseif {[string equal "http" $parts(scheme)]} {
  11. set tmp /tmp
  12. if {[info exists env(TEMP)]} { set tmp $env(TEMP) }
  13. if {[file isdirectory $tmp]} {
  14. set tmpname [file join $tmp [file tail $parts(path)]]
  15. if {[file exists $tmpname]} {
  16. set f [open $tmpname r]
  17. set data [read $f]
  18. close $f
  19. return $data
  20. }
  21. }
  22.  
  23. set tok [http::geturl $url -timeout 30000]
  24. if {[string equal [http::status $tok] "ok"]} {
  25. set data [http::data $tok]
  26. http::cleanup $tok
  27. if {[file isdirectory $tmp]} {
  28. set f [open [file join $tmp [file tail $parts(path)]] w]
  29. puts -nonewline $f $data
  30. close $f
  31. }
  32. } else {
  33. set err [http::error $tok]
  34. http::cleanup $tok
  35. return -code error $err
  36. }
  37. } else {
  38. return -code error "scheme \"$parts(scheme)\" not supported"
  39. }
  40. return $data
  41. }