1# -*- tcl -*- 2# # ## ### ##### ######## ############# 3# (C) 2009 Andreas Kupries 4 5# @@ Meta Begin 6# Package tcl::transform::counter 1 7# Meta as::author {Andreas Kupries} 8# Meta as::copyright 2009 9# Meta as::license BSD 10# Meta as::notes For other observers see adler32, crc32, 11# Meta as::notes identity, and observer (stream copy). 12# Meta as::notes Possibilities for extension: Separate 13# Meta as::notes counters per byte value. Count over 14# Meta as::notes fixed time-intervals = channel speed. 15# Meta as::notes Use callbacks or traces to save changes 16# Meta as::notes in the counters, etc. as time-series. 17# Meta as::notes Compute statistics over the time-series. 18# Meta description Implementation of a counter 19# Meta description transformation. Based on Tcl 8.6's 20# Meta description transformation reflection support (TIP 21# Meta description 230). An observer instead of a 22# Meta description transformation, it counts the number of 23# Meta description bytes read and written. The observer 24# Meta description saves the counts into two external 25# Meta description namespaced variables specified at 26# Meta description construction time. Exports a single 27# Meta description command adding a new transformation of 28# Meta description this type to a channel. One argument, 29# Meta description the channel to extend, plus options to 30# Meta description specify the variables for the counters. 31# Meta description No result. 32# Meta platform tcl 33# Meta require tcl::transform::core 34# Meta require {Tcl 8.6} 35# @@ Meta End 36 37# # ## ### ##### ######## ############# 38 39package require Tcl 8.6 40package require tcl::transform::core 41 42# # ## ### ##### ######## ############# 43 44namespace eval ::tcl::transform {} 45 46proc ::tcl::transform::counter {chan args} { 47 ::chan push $chan [counter::implementation new {*}$args] 48} 49 50oo::class create ::tcl::transform::counter::implementation { 51 superclass tcl::transform::core ;# -> initialize, finalize, destructor 52 53 method write {c data} { 54 my Count -write-variable $data 55 return $data 56 } 57 58 method read {c data} { 59 my Count -read-variable $data 60 return $data 61 } 62 63 # No partial data, nor state => no flush, drain, nor clear needed. 64 65 # # ## ### ##### ######## ############# 66 67 constructor {args} { 68 array set options { 69 -read-variable {} 70 -write-variable {} 71 } 72 # todo: validity checking of options (legal names, legal 73 # values, etc.) 74 array set options $args 75 return 76 } 77 78 # # ## ### ##### ######## ############# 79 80 variable options 81 82 # # ## ### ##### ######## ############# 83 84 method Count {o data} { 85 if {$options($o) eq ""} return 86 upvar #0 $options($o) counter 87 incr counter [string length $data] 88 return 89 } 90} 91 92# # ## ### ##### ######## ############# 93package provide tcl::transform::counter 1 94return 95