rrdreel

Check-in [2eb0e0bfb3]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Switch to tcl implementation
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256:2eb0e0bfb34fb18ab9ac1bf426ff111224f946445ba50d6fbdff125e415a75fe
User & Date: jef 2018-08-29 21:05:39
Context
2018-08-29
21:06
Switch to tcl implementation check-in: fc74e44c02 user: jef tags: trunk
21:05
Switch to tcl implementation check-in: 2eb0e0bfb3 user: jef tags: trunk
2018-06-12
18:27
Update README.md after fossil migration check-in: 9e4161e4e1 user: jef tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to rrdreel.

1

2
3
4

5
6
7

8
9
10
11
12
13
14
15
16
17


18
19
20
21



22
23
24
25
26
27
28
29
30


31




32
33
34
35
36
37
38
39




40
41
42
43
44
45
46
47
48
49



50
51
52



53
54
55

56
57
58
59
60
61
62
63
64
65
66
67





68
69
70
71











72
73
74
75
76
77


78
79

80
81
82
83



84
85
86
87

88
89
90
91
92
93
94
95
96


97
98
99
100











101
102
103





























































































































104
105
106
107
108
109
110






































111
112
113
114
115
116
117


#!/usr/bin/env perl

#
# Live data visualisation framework
# Copyright (c) 2016 Gerome Fournier


use strict;
use warnings;

use 5.010;

use Tk;
use Tk::Menu;
use Tk::widgets qw(PNG);
use IO::Select;
use File::Basename qw(dirname);
use lib dirname($0);

our $cleanup;



sub graph {
        my ($backend) = @_;




        $backend->rrd_create();

        my $mw = MainWindow->new;
        $mw->bind($mw, "<Control-w>" => $cleanup);
        my $photo = $mw->Label()->pack();

        # callback for image update
        my $img_update = sub {
                state $lastimage;







                $backend->graph_update();
                my $image = $mw->Photo(-file => $backend->graph_file());
                $photo->configure(-image => $image);
                $mw->update();
                $lastimage->delete() if defined $lastimage;
                $lastimage = $image;
        };





        # callback for RRD update
        my $rrd_update;
        $rrd_update = sub {
                state $select;

                if (not defined $select) {
                        $select = IO::Select->new();
                        $select->add(\*STDIN);
                }




                if ($select->can_read(.1)) {
                        $backend->rrd_update();
                        $img_update->();



                }
                $mw->after(100, $rrd_update);
        };


        # popup menu to select timeslot view
        my $menu = $mw->Menu(-tearoff => 0);
        foreach my $ts (@{ $backend->timeslots() }) {
                $menu->add('command',
			-label => $ts->{label},
			-command => sub {
		                $backend->timeslot_set($ts);
                		$img_update->();
			});
        }






        # callback for menu click
        my $showmenu = sub {
                my ($self, $x, $y, $widget) = @_;
                $menu->post($x, $y);











        };

        # bind callback on left mouse button
        $mw->bind('<3>', [$showmenu, Ev('X'), Ev('Y'), Ev('W')]);

        # launch the gui


        $rrd_update->();
        MainLoop();

}

sub backend_load {
        my ($backend_name, @args) = @_;




        my $backend = "backends::$backend_name";
        eval "use $backend; 1" or die "Unable to load backend '$backend_name':\n$@";


        return $backend->new(@args);
}

sub usage {
	my ($progname) = $0 =~ /([^\/]+)$/;

	print <<EOF;
Live monitoring framework
Look into examples directory for usage scenarios



Options:
    -h : display this help and exit
EOF











}

if (@ARGV and $ARGV[0] eq "-h") {





























































































































	usage;
	exit;
}

my $backend = backend_load(@ARGV);
$cleanup = sub {
        $backend->cleanup();






































        Tk::exit();
};

local $SIG{INT} = $cleanup;
local $SIG{TERM} = $cleanup;

graph($backend);


|
>
|
<
|
>

<
<
>
|

|
|
|
|
<
<

<
>
>
|
<
<

>
>
>
|
|
<
<
<

<
<
<
>
>

>
>
>
>
|
|
|
<
<
<
<

>
>
>
>
|
|
|
|
|
<
<
<
|

>
>
>
|
|
|
>
>
>
|
<
<
>
|
<
<
|
<
<
<
<
|
<
|

>
>
>
>
>
|
|
|
|
>
>
>
>
>
>
>
>
>
>
>
|
|
<
<

<
>
>
|
<
>
|

<
<
>
>
>
|
<
<

>
|
|
|
<
<

<
<
<
>
>

<
<
<
>
>
>
>
>
>
>
>
>
>
>
|

<
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
|
|
<
<
<
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
<
|
<
<
|
<
>
>
1
2
3

4
5
6


7
8
9
10
11
12
13


14

15
16
17


18
19
20
21
22
23



24



25
26
27
28
29
30
31
32
33
34




35
36
37
38
39
40
41
42
43
44



45
46
47
48
49
50
51
52
53
54
55
56


57
58


59




60

61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84


85

86
87
88

89
90
91


92
93
94
95


96
97
98
99
100


101



102
103
104



105
106
107
108
109
110
111
112
113
114
115
116
117

118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246



247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285

286


287

288
289
#!/usr/bin/env tclsh8.6
# vim: ft=tcl


set argv [linsert $argv 0 --]
package require Tk



#------------------------------------------------------------------------------
# Utils

proc usage {} {
	puts \
{Live monitoring framework
Look into examples directory for usage scenarios




Options:
	-h : display this help and exit}
}



proc tmp_file {} {
	set fh [file tempfile tmpfile [file join /tmp rrdreel]]
	close $fh
	return $tmpfile
}







#------------------------------------------------------------------------------
# Rrdplot (base class)

oo::class create rrdplot {
	variable params
	variable rrd_file
	variable png_file
	variable range
	variable graph_width
	variable graph_height





	method timeslots {} {
		return {
			{label "last 5 mns" range 300}
			{label "last 15 mns" range 900}
			{label "last 30 mns" range 1800}
			{label "last hour" range 3600}
			{label "last 12 hours" range 42300}
			{label "last day" range 86400}
		}



	}

	method init {opts} {
		set rrd_file [tmp_file]
		set png_file [tmp_file]
		set range 300
		set graph_width 600
		set graph_height 120
		foreach {key value} $opts {
			if {$key ni [dict keys $params]} {
				error "invalid argument '$key'"
			}


			dict set params $key $value
		}


		my rrd_create




		my png_update 0

	}

	method rras {} {
		set step [dict get $params step]
		set rras {}
		foreach ts [my timeslots] {
			set ndata [expr {int(ceil([dict get $ts range] / $step))}]
			if {$ndata < $graph_width} {
				lassign [list 1 $ndata] steps rows
			} else {
				lassign [list [expr {int(ceil($ndata / $graph_width))}] $graph_width] steps rows
			}

			if {[dict exists $rras $steps]} {
				dict set rras $steps [expr max($rows, [dict get $rras $steps])]
			} else {
				dict set rras $steps $rows
			}
		}

		return [lmap {steps rows} $rras {
			format {RRA:AVERAGE:0.5:%d:%d} $steps $rows
		}]
	}




	method set_range {value} {
		set range $value
		my png_update 0

		gui_update [my png_file]
	}



	method cleanup {} {
		file delete $rrd_file
		file delete $png_file
	}



	method png_file {} {
		return $png_file
	}
}






#------------------------------------------------------------------------------
# Gauge




oo::class create gauge {
	superclass rrdplot
	constructor {opts} {
		my variable params
		set params [list \
			step 1 \
			title {} \
			vlabel {} \
			legend {} \
			unit {}]
		my init $opts
	}


	method rrd_create {} {
		my variable rrd_file
		my variable params
		dict with params {
			set heartbeat [expr {$step * 2}]
			exec rrdtool create $rrd_file -bN -s$step \
				"DS:gauge:GAUGE:$heartbeat:U:U" \
				{*}[my rras]
		}
	}

	method rrd_update {} {
		my variable rrd_file
		gets stdin value
		if {$value ne {}} {
			exec rrdtool update $rrd_file -t gauge "N:$value"
		}
	}

	method png_update {{lazy 1}} {
		my variable rrd_file
		my variable png_file
		my variable graph_width
		my variable graph_height
		my variable params
		my variable range
		puts $range
		dict with params {
			set cmd [list rrdtool graph $png_file \
				-s "-$range" \
				-t $title \
				-h $graph_height \
				-w $graph_width \
				-l 0 -a PNG -v $vlabel \
				"DEF:gauge=$rrd_file:gauge:AVERAGE" \
				"AREA:gauge#32CD32:$legend" \
				"LINE1:gauge#336600" \
				"GPRINT:gauge:MAX: Max\\: %5.1lf %s" \
				"GPRINT:gauge:AVERAGE: Avg\\: %5.1lf %S" \
				"GPRINT:gauge:LAST: Current\\: %5.1lf %S$unit\\n" \
				"HRULE:0#000000"]
			if {$lazy} { lappend cmd {--lazy} }
			exec {*}$cmd
		}
	}
}

#------------------------------------------------------------------------------
# Interface

oo::class create interface {
	superclass rrdplot
	constructor {opts} {
		my variable params
		set params [list \
			step 1 \
			title "Traffic on interface" \
			vlabel "Bits per second" \
			in_legend In \
			in_unit bits \
			out_legend Out \
			out_unit bits]
		my init $opts
	}

	method rrd_create {} {
		my variable params
		my variable rrd_file
		dict with params {
			set heartbeat [expr {$step * 2}]
			exec rrdtool create $rrd_file -bN -s$step \
				"DS:in:DERIVE:$heartbeat:0:U" \
				"DS:out:DERIVE:$heartbeat:0:U" \
				{*}[my rras]
		}
	}

	method rrd_update {} {
		my variable rrd_file
		gets stdin value
		if {$value ne {}} {
			lassign $value in out
			exec rrdtool update $rrd_file -t {in:out} "N:$in:$out"
		}
	}

	method png_update {{lazy 1}} {
		my variable rrd_file
		my variable png_file
		my variable graph_height
		my variable graph_width
		my variable params
		my variable range
		dict with params {
			set cmd [list rrdtool graph $png_file \
				-s "-$range" \
				-t $title \
				-h $graph_height \
				-w $graph_width \
				-l 0 -a PNG -v $vlabel \
				"DEF:in=$rrd_file:in:AVERAGE" \
				"DEF:out=$rrd_file:out:AVERAGE" \
				"CDEF:out_neg=out,-1,*" \
				"AREA:in#32CD32:$in_legend" \
				"LINE1:in#336600" \
				"GPRINT:in:MAX:  Max\\: %.1lf %s" \
				"GPRINT:in:AVERAGE: Avg\\: %.1lf %S" \
				"GPRINT:in:LAST: Current\\: %.1lf %S$in_unit\\n"  \
				"AREA:out_neg#4169E1:$out_legend" \
				"LINE1:out_neg#0033CC" \
				"GPRINT:out:MAX:  Max\\: %.1lf %S" \
				"GPRINT:out:AVERAGE: Avg\\: %.1lf %S" \
				"GPRINT:out:LAST: Current\\: %.1lf %S$out_unit\\n" \
				"HRULE:0#000000"]
			if {$lazy} { lappend cmd {--lazy} }
			exec {*}$cmd
		}
	}
}

#------------------------------------------------------------------------------
# Parse command line

switch -- [lindex $argv 0] {
	-h {
		usage
		exit 0
	}
}




#------------------------------------------------------------------------------
# Gui

proc gui_init {} {
	bind . <Escape> {$::plot cleanup; exit}
	menu .menu -tearoff 0
	foreach ts [$::plot timeslots] {
		.menu add command \
			-label [dict get $ts label] \
			-command "\$::plot set_range [dict get $ts range]"
	}
	pack [label .image]
	bind .image <1> {tk_popup .menu %X %Y}
}

proc gui_update {png_file} {
	image create photo img -file $png_file
	.image configure -image img
}

#------------------------------------------------------------------------------
# Instantiate ::plot backend

set argv [lassign $argv backend]
switch -exact -- $backend {
	gauge -
	interface {
		set plot [${backend} new $argv]
		gui_init
		fileevent stdin readable {
			$::plot rrd_update
			$::plot png_update
			gui_update [$::plot png_file]
		}
	}
	default {
		puts stderr "invalid backend value: '$backend'"
		exit 1

	}


}


vwait forever