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