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