Tcl Source Code

Artifact 5a034d32c3ff0726ef88b9fa33684d87896f623c1f534a4f5658748f5c1222a7:

Attachment "test_download.tcl" to ticket [fb642c54bc] added by gerhardr 2018-03-27 12:19:16. (unpublished)

---

set http_ver [package require http]

proc httpcopy { url file {chunk 4096} } {
  set out [open $file w]
  set token [::http::geturl $url -channel $out \
      -progress httpCopyProgress -blocksize $chunk \
      -headers {Accept-Encoding identity}]
  close $out
  
  # This ends the line started by httpCopyProgress
  puts stderr ""
  
  upvar #0 $token state
  set max 0
  foreach {name value} $state(meta) {
    if {[string length $name] > $max} {
      set max [string length $name]
    }
    if {[regexp -nocase ^location$ $name]} {
      # Handle URL redirects
      puts stderr "Location:$value"
      return [httpcopy [string trim $value] $file $chunk]
    }
  }
  incr max
  foreach {name value} $state(meta) {
    puts [format "%-*s %s" $max $name: $value]
  }
  
  return $token
}
proc httpCopyProgress {args} {
  puts -nonewline stderr .
  flush stderr
}

#
# === Here starts my additional testing code ===
#
if {[llength $argv]} {
  set url [lindex $argv 0]
} else {
  set url "http://someonewhocares.org/hosts/hosts"
}
set org "outfile1.txt"
set out "outfile2.txt"

puts "Loading file $org from $url using wget"
catch {exec wget $url -O $org}

puts "Loading file $out from $url via httpcopy"
httpcopy $url $out
puts "HTTP file copy size is [file size $out], wget filesize is [file size $org]"
puts "Platform: $tcl_platform(os) $tcl_platform(machine) $tcl_platform(osVersion)"
puts "TCL [info patchlevel], package http version $http_ver"