Posted to tcl by aspect at Thu Dec 24 02:43:05 GMT 2015view pretty

namespace eval Net {
    variable interface {}
 
    namespace eval Stats {
        proc Start {callback} {
            variable Counter
            coroutine Capture#[incr Counter] Capture $callback
        }
 
        proc Capture {callback} {
            after 0 [info coroutine]    ;# schedule the coro to start immediately ..
            yield [info coroutine]      ;# and return its name
            set data [getSet]
            set rxPerSecond [expr {(double([lindex $data 0]) / [lindex $data 2]) * 1000}]
            set txPerSecond [expr {(double([lindex $data 1]) / [lindex $data 2]) * 1000}]
            $callback $rxPerSecond $txPerSecond
        }
 
        proc getSet {} {
            set 1 [getStats]
            puts "Get 1"
            after 1000 [info coroutine]     ;# wake me up in 1000ms
            yield                           ;# go to sleep
            set 2 [getStats]
            puts "Get 2"
            set timePassed [expr {[lindex $2 2] - [lindex $1 2]}]
            set rx [expr {[lindex $2 0] - [lindex $1 0]}]
            set tx [expr {[lindex $2 1] - [lindex $1 1]}]
            return [list $rx $tx $timePassed]
        }
 
        proc getStats {} {
            variable [namespace parent]::interface
 
            if {$interface eq ""} {
                [namespace parent]::getInterface
                return [getStats]
            }
            try {
                set fh [ open [list | cat /sys/class/net/${interface}/statistics/rx_bytes] ]
                set rx [gets $fh]
                close $fh
                set fh [ open [list | cat /sys/class/net/${interface}/statistics/tx_bytes] ]
                set tx [gets $fh]
                close $fh
                set timestamp [clock milliseconds]
            } on error {result options} {
                puts Error
                ::onError $result $options
                return
            }
            return [list $rx $tx $timestamp]
        }
 
    }
 
    proc getInterface {} {
        variable interface
        try {
            set fh [ open [list | ls -1 /sys/class/net | head -n 1] ]
            set interface [gets $fh]
            close $fh
        } on error {result options} {
            ::onError $result $options
            return
        }
        set interface $interface
    }
 
}
 
proc myProc {rx tx} {
    puts "Receive: $rx B/S"
    puts "Transmit: $tx B/S"
}
 
::Net::Stats::Start myProc
puts "After Get Stats"
after 1000 {puts "1 Second"}
after 5000 {set i 0}
vwait i
puts "Finished"