tests/multi/cancelTrans.tcl

   1 #!/usr/local/bin/wish8.4
   2
   3 package require TclCurl
   4
   5 proc ProgressCallback {dltotal dlnow ultotal ulnow} {
   6
   7     set dltotal [expr round($dltotal)]
   8     set dlnow   [expr round($dlnow)]
   9     set ultotal [expr round($ultotal)]
  10     set ulnow   [expr round($ulnow)]
  11
  12     puts "Progress callback: $dltotal - $dlnow - $ultotal - $ulnow"
  13
  14     return
  15 }
  16
  17 proc Perform {multiHandle} {
  18     if {[catch {$multiHandle active} activeTransfers]} {
  19         puts "Error checking active transfers: $activeTransfers"
  20         return -1
  21     }
  22
  23     if {[catch {$multiHandle perform} running]} {
  24         puts "Error: $running"
  25         return -1
  26     }
  27     return $running
  28 }
  29
  30 proc Transfer {multiHandle easyHandle} {
  31     global eventId
  32     set runningTransfers [Perform $multiHandle]
  33     if {$runningTransfers>0} {
  34         set eventId [after 200 "Transfer $multiHandle $easyHandle"]
  35     } else {
  36         puts "Were are done, cleaning up..."
  37         $multiHandle removehandle $easyHandle
  38         $easyHandle  cleanup
  39         $multiHandle cleanup
  40         puts "All done"
  41     }
  42     return
  43 }
  44
  45 proc StartTransfer {} {
  46
  47     set curlEasyHandle [curl::init]
  48
  49     $curlEasyHandle configure -url "127.0.0.1/~andres/cosa&co.tar"          \
  50             -canceltransvarname cancel   -progressproc ProgressCallback\
  51             -file cosa.tar -noprogress 0
  52
  53     set curlMultiHandle [curl::multiinit]
  54     $curlMultiHandle addhandle $curlEasyHandle
  55
  56     after 100 "Transfer $curlMultiHandle $curlEasyHandle"
  57
  58     return
  59 }
  60
  61 proc StopTransfer {} {
  62     global cancel eventId
  63
  64     puts "The download has been cancelled"
  65
  66     set cancel 1
  67
  68     return
  69 }
  70
  71 set start [button .start -text Start -command StartTransfer]
  72 set stop  [button .stop  -text Stop  -command StopTransfer]
  73
  74 pack $start $stop -side left -padx 10 -pady 10
  75
  76
  77
  78
  79
  80