1# timing.tcl --- 2# 3# A collection of procedures to measure bytes per seconds during network 4# operations. 5# 6# Copyright (c) 2004 Mats Bengtsson 7# 8# This file is distributed under BSD style license. 9# 10# $Id: timing.tcl,v 1.4 2007-07-19 06:28:11 matben Exp $ 11 12package provide timing 1.0 13 14namespace eval ::timing:: { 15 16 variable priv 17} 18 19# timing::setbytes -- 20# 21# A number of utils that handle timing objects. Mainly to get bytes 22# per second during file transfer. 23# 24# Arguments: 25# key a unique key to identify a particular timing object, 26# typically use the socket token or a running namespaced 27# number. 28# bytes number of bytes transported so far 29# totalbytes total file size in bytes 30# 31# Results: 32# none 33 34proc ::timing::setbytes {key bytes} { 35 variable priv 36 37 set ms [clock clicks -milliseconds] 38 lappend priv($key) [list [expr {double($ms)}] $bytes] 39 return 40} 41 42proc ::timing::getrate {key} { 43 variable priv 44 45 set len [llength $priv($key)] 46 if {$len <= 1} { 47 return 0.0 48 } 49 set n 12 50 set tm $priv($key) 51 set millis [expr {[lindex $tm end 0] - [lindex $tm 0 0]}] 52 set bytes [expr {[lindex $tm end 1] - [lindex $tm 0 1]}] 53 54 # Treat the case with wrap around. (Guess) 55 if {$millis <= 0} { 56 set millis 1000000 57 } 58 59 # Keep only a small part. 60 set priv($key) [lrange $priv($key) end-${n} end] 61 62 # Returns average bytes per second. 63 set rate [expr {1000.0 * $bytes / ($millis + 1.0)}] 64 set priv($key,lastrate) $rate 65 return $rate 66} 67 68proc ::timing::getlinearinterp {key} { 69 variable priv 70 71 set len [llength $priv($key)] 72 if {$len <= 1} { 73 return 0.0 74 } 75 set n 12 76 77 # Keep only the part we are interested in. 78 set priv($key) [lrange $priv($key) end-{n} end] 79 set sumx 0.0 80 set sumy 0.0 81 set sumxy 0.0 82 set sumx2 0.0 83 84 # Need to move origin to get numerical stability! 85 set x0 [lindex $priv($key) 0 0] 86 set y0 [lindex $priv($key) 0 1] 87 foreach co $priv($key) { 88 set x [expr {[lindex $co 0] - $x0}] 89 set y [expr {[lindex $co 1] - $y0}] 90 set sumx [expr {$sumx + $x}] 91 set sumy [expr {$sumy + $y}] 92 set sumxy [expr {$sumxy + $x * $y}] 93 set sumx2 [expr {$sumx2 + $x * $x}] 94 } 95 96 # This is bytes per millisecond. 97 set k [expr {($n * $sumxy - $sumx * $sumy) / \ 98 ($n * $sumx2 - $sumx * $sumx)}] 99 return [expr {1000.0 * $k}] 100} 101 102proc ::timing::getpercent {key totalbytes} { 103 variable priv 104 105 if {[llength $priv($key)] > 1} { 106 set bytes [lindex $priv($key) end 1] 107 } else { 108 set bytes 0 109 } 110 set percent [format %3.0f [expr {100.0 * $bytes/($totalbytes + 1.0)}]] 111 set percent [expr {$percent < 0 ? 0 : $percent}] 112 set percent [expr {$percent > 100 ? 100 : $percent}] 113 return $percent 114} 115 116proc ::timing::getmessage {key totalbytes} { 117 variable priv 118 119 set bpersec [getrate $key] 120 121 # Find format: bytes or k. 122 if {$bpersec < 1000} { 123 set txtRate "[expr {int($bpersec)}] bytes/sec" 124 } elseif {$bpersec < 1000000} { 125 set txtRate "[format %.1f [expr {$bpersec/1000.0}] ]Kb/sec" 126 } else { 127 set txtRate "[format %.1f [expr {$bpersec/1000000.0}] ]Mb/sec" 128 } 129 130 # Remaining time. 131 if {[llength $priv($key)] > 1} { 132 set bytes [lindex $priv($key) end 1] 133 } else { 134 set bytes 0 135 } 136 set percent [format %3.0f [expr {100.0 * $bytes/($totalbytes + 1.0)}]] 137 set secsLeft [expr {int(ceil(($totalbytes - $bytes)/($bpersec + 1.0)))}] 138 if {$secsLeft < 60} { 139 set txtTimeLeft ", $secsLeft secs remaining" 140 } elseif {$secsLeft < 120} { 141 set txtTimeLeft ", one minute and [expr {$secsLeft - 60}] secs remaining" 142 } else { 143 set txtTimeLeft ", [expr {$secsLeft/60}] minutes remaining" 144 } 145 return "${txtRate}${txtTimeLeft}" 146} 147 148proc ::timing::free {key} { 149 variable priv 150 151 unset -nocomplain priv($key) 152} 153 154#------------------------------------------------------------------------------- 155 156