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

  1. namespace eval Net {
  2. variable interface {}
  3.  
  4. namespace eval Stats {
  5. proc Start {callback} {
  6. variable Counter
  7. coroutine Capture#[incr Counter] Capture $callback
  8. }
  9.  
  10. proc Capture {callback} {
  11. after 0 [info coroutine] ;# schedule the coro to start immediately ..
  12. yield [info coroutine] ;# and return its name
  13. set data [getSet]
  14. set rxPerSecond [expr {(double([lindex $data 0]) / [lindex $data 2]) * 1000}]
  15. set txPerSecond [expr {(double([lindex $data 1]) / [lindex $data 2]) * 1000}]
  16. $callback $rxPerSecond $txPerSecond
  17. }
  18.  
  19. proc getSet {} {
  20. set 1 [getStats]
  21. puts "Get 1"
  22. after 1000 [info coroutine] ;# wake me up in 1000ms
  23. yield ;# go to sleep
  24. set 2 [getStats]
  25. puts "Get 2"
  26. set timePassed [expr {[lindex $2 2] - [lindex $1 2]}]
  27. set rx [expr {[lindex $2 0] - [lindex $1 0]}]
  28. set tx [expr {[lindex $2 1] - [lindex $1 1]}]
  29. return [list $rx $tx $timePassed]
  30. }
  31.  
  32. proc getStats {} {
  33. variable [namespace parent]::interface
  34.  
  35. if {$interface eq ""} {
  36. [namespace parent]::getInterface
  37. return [getStats]
  38. }
  39. try {
  40. set fh [ open [list | cat /sys/class/net/${interface}/statistics/rx_bytes] ]
  41. set rx [gets $fh]
  42. close $fh
  43. set fh [ open [list | cat /sys/class/net/${interface}/statistics/tx_bytes] ]
  44. set tx [gets $fh]
  45. close $fh
  46. set timestamp [clock milliseconds]
  47. } on error {result options} {
  48. puts Error
  49. ::onError $result $options
  50. return
  51. }
  52. return [list $rx $tx $timestamp]
  53. }
  54.  
  55. }
  56.  
  57. proc getInterface {} {
  58. variable interface
  59. try {
  60. set fh [ open [list | ls -1 /sys/class/net | head -n 1] ]
  61. set interface [gets $fh]
  62. close $fh
  63. } on error {result options} {
  64. ::onError $result $options
  65. return
  66. }
  67. set interface $interface
  68. }
  69.  
  70. }
  71.  
  72. proc myProc {rx tx} {
  73. puts "Receive: $rx B/S"
  74. puts "Transmit: $tx B/S"
  75. }
  76.  
  77. ::Net::Stats::Start myProc
  78. puts "After Get Stats"
  79. after 1000 {puts "1 Second"}
  80. after 5000 {set i 0}
  81. vwait i
  82. puts "Finished"
  83.