1# Copyright (c) 2016-2017, OARC, Inc.
2# Copyright (c) 2007, The Measurement Factory, Inc.
3# Copyright (c) 2007, Internet Systems Consortium, Inc.
4# All rights reserved.
5#
6# Redistribution and use in source and binary forms, with or without
7# modification, are permitted provided that the following conditions
8# are met:
9#
10# 1. Redistributions of source code must retain the above copyright
11#    notice, this list of conditions and the following disclaimer.
12#
13# 2. Redistributions in binary form must reproduce the above copyright
14#    notice, this list of conditions and the following disclaimer in
15#    the documentation and/or other materials provided with the
16#    distribution.
17#
18# 3. Neither the name of the copyright holder nor the names of its
19#    contributors may be used to endorse or promote products derived
20#    from this software without specific prior written permission.
21#
22# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
23# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
24# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
25# FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
26# COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
27# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
28# BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
29# LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
30# CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
31# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
32# ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
33# POSSIBILITY OF SUCH DAMAGE.
34
35package DSC::ploticus;
36
37use Data::Dumper;
38use POSIX;
39use File::Temp qw();
40
41use strict;
42
43BEGIN {
44        use Exporter   ();
45        use vars       qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
46        $VERSION     = '2.04';
47        @ISA         = qw(Exporter);
48        @EXPORT      = qw(
49		&ploticus_init
50		&ploticus_arg
51		&ploticus_begin
52		&ploticus_end
53		&Ploticus_create_datafile
54		&Ploticus_create_datafile_keyless
55		&Ploticus_getdata
56		&Ploticus_areadef
57		&Ploticus_bars_vstacked
58		&Ploticus_bars
59		&Ploticus_lines
60		&Ploticus_lines_stacked
61		&Ploticus_xaxis
62		&Ploticus_yaxis
63		&Ploticus_legend
64		&Ploticus_categories
65		&Ploticus_legendentry
66		&Ploticus_annotate
67		&window2increment
68		&extract_server_from_datafile_path
69		&extract_node_from_datafile_path
70		&index_in_array
71		&plotdata_tmp
72	 );
73        %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],
74        @EXPORT_OK   = qw();
75}
76use vars      @EXPORT;
77use vars      @EXPORT_OK;
78
79END { }
80
81my $plotdata_tmp = '/tmp/plotdataXXXXXXXXXXXXXX';
82my $strftimefmt = '%D.%T';
83
84sub plotdata_tmp {
85	my $label = shift;
86	my $obj;
87	if (defined($label)) {
88		$obj = new File::Temp(TEMPLATE => "/tmp/plotdata.$label.XXXXXXXXXXXXX");
89	} else {
90		$obj = new File::Temp(TEMPLATE => $plotdata_tmp);
91	}
92	$obj;
93}
94
95sub Ploticus_create_datafile {
96	my $hashref = shift;
97	my $keysarrayref = shift;
98	my $FH = shift;
99	my $time_bin_size = shift || 60;
100	my $end = shift;
101	my $window = shift;
102	my $divideflag = shift;
103	my %newhash;
104	my %COUNT;
105	my $cutoff = $end - $window;
106	$divideflag = 0 unless defined($divideflag);
107	#
108	# convert the original data into possibly larger bins
109	#
110	foreach my $fromkey (sort {$a <=> $b} keys %$hashref) {
111		# note $fromkey is a time_t.
112		next if ($fromkey < $cutoff);
113		next if ($fromkey > $end);	# if clock skew
114		my $tokey = $fromkey - ($fromkey % $time_bin_size);
115		foreach my $k1 (@$keysarrayref) {
116			if (defined($hashref->{$fromkey}{$k1})) {
117				$newhash{$tokey}{$k1} += $hashref->{$fromkey}{$k1};
118			}
119			# always increment the denominator, even for undef values
120			# otherwise averaging comes out wrong, and really creates
121			# problems with missing data on percentage plots
122			$COUNT{$tokey}{$k1}++;
123		}
124	}
125
126	#
127	# bail here for empty datasets;
128	#
129	return 0 unless (keys %newhash);
130
131	#
132	# now write the new data
133	#
134	my $nl = 0;
135	my $DF = $divideflag ? 60 : 1;
136	foreach my $tokey (sort {$a <=> $b} keys %newhash ) {
137		my @v = ();
138		foreach my $k1 (@$keysarrayref) {
139			push (@v, defined($newhash{$tokey}{$k1}) ? $newhash{$tokey}{$k1} / ($DF*$COUNT{$tokey}{$k1}): '-');
140		}
141		print $FH join(' ', POSIX::strftime($strftimefmt, localtime($tokey)), @v), "\n";
142		$nl++;
143	}
144	close($FH);
145	$nl;
146}
147
148sub Ploticus_create_datafile_keyless {
149	my $hashref = shift;
150	my $keysarrayref = shift;
151	my $FH = shift;
152	my $time_bin_size = shift || 60;
153	my $end = shift;
154	my $window = shift;
155	my $divideflag = shift;
156	my %newhash;
157	my %COUNT;
158	my $cutoff = $end - $window;
159	$divideflag = 0 unless defined($divideflag);
160	#
161	# convert the original data into possibly larger bins
162	#
163	foreach my $fromkey (sort {$a <=> $b} keys %$hashref) {
164		# note $fromkey is a time_t.
165		next if ($fromkey < $cutoff);
166		next if ($fromkey > $end);	# if clock skew
167		my $tokey = $fromkey - ($fromkey % $time_bin_size);
168		$newhash{$tokey} += $hashref->{$fromkey};
169		# always increment the denominator, even for undef values
170		# otherwise averaging comes out wrong, and really creates
171		# problems with missing data on percentage plots
172		$COUNT{$tokey}++;
173	}
174
175	#
176	# bail here for empty datasets;
177	#
178	return 0 unless (keys %newhash);
179
180	#
181	# now write the new data
182	#
183	my $nl = 0;
184	my $DF = $divideflag ? 60 : 1;
185	foreach my $tokey (sort {$a <=> $b} keys %newhash ) {
186		print $FH join(' ',
187			POSIX::strftime($strftimefmt, localtime($tokey)),
188			defined($newhash{$tokey}) ? $newhash{$tokey} / ($DF*$COUNT{$tokey}): '-'
189			), "\n";
190		$nl++;
191	}
192	close($FH);
193	$nl;
194}
195
196sub Ploticus_getdata {
197	my $datafile = shift;
198	P("#proc getdata");
199	P("file: $datafile");
200}
201
202
203sub Ploticus_areadef{
204	my $ropts = shift;
205	P("#proc areadef");
206	PO($ropts, 'title');
207	PO($ropts, 'rectangle', '1 1 6 4');
208	PO($ropts, 'xscaletype');
209	my $window = $ropts->{-window};
210	my $end = $ropts->{-end};
211	if (defined($window)) {
212		my $then = $end - $window;
213	#	   $then -= ($then % &window2increment($window));
214		my $range_begin = POSIX::strftime($strftimefmt, localtime($then));
215		my $range_end = POSIX::strftime($strftimefmt, localtime($end));
216		P("xrange: $range_begin $range_end");
217	} elsif (defined($ropts->{-xstackfields})) {
218		P("xautorange: datafield=$ropts->{-xstackfields} combomode=stack lowfix=0");
219	} else {
220		P("xautorange: datafield=1");
221	}
222	PO($ropts, 'yscaletype');
223	if (defined($ropts->{-ystackfields})) {
224		P("yautorange: datafield=$ropts->{-ystackfields} combomode=stack lowfix=0");
225	} elsif (defined ($ropts->{-yfields})) {
226		P("yautorange: datafield=$ropts->{-yfields}");
227	}
228}
229
230sub Ploticus_bars_vstacked { Ploticus_bars(shift); }
231
232sub Ploticus_bars {
233	my $ropts = shift;
234
235	foreach my $i (@{$ropts->{-indexesarrayref}}) {
236		my $field = $i+2;
237		P("#proc bars");
238		P('outline: no');
239		P('hidezerobars: yes');
240		P("lenfield: $field");
241		PO($ropts, 'horizontalbars');
242		PO($ropts, 'locfield', '1');
243		PO($ropts, 'stackfields', '*');
244		PO($ropts, 'barwidth');
245		if (defined($ropts->{-exactcolorfield})) {
246			PO($ropts, 'exactcolorfield');
247		} elsif (defined($ropts->{-colorfield})) {
248			PO($ropts, 'colorfield');
249		} else {
250			P("color: ${$ropts->{-colorsarrayref}}[$i]");
251		}
252		if (defined($ropts->{-labelsarrayref})) {
253			my $legendlabel;
254			# generate clickmap entries for the legend based on
255			# a printf-like template
256			if (defined($ropts->{-legend_clickmapurl_tmpl})) {
257				my $URI = $ropts->{-legend_clickmapurl_tmpl};
258				$URI =~ s/\@LEGEND\@/${$ropts->{-labelsarrayref}}[$i]/;
259				$URI =~ s/\@KEY\@/${$ropts->{-keysarrayref}}[$i]/;
260				$legendlabel .= "url:$URI ";
261			}
262			$legendlabel .= ${$ropts->{-labelsarrayref}}[$i];
263			P("legendlabel: $legendlabel");
264		}
265		PO($ropts, 'clickmapurl');
266	}
267	PO($ropts, 'labelfield');
268	P("labelzerovalue: yes") if defined($ropts->{-labelfield});
269}
270
271sub Ploticus_lines {
272	my $ropts = shift;
273
274	foreach my $i (@{$ropts->{-indexesarrayref}}) {
275		my $field = $i+2;
276		P("#proc lineplot");
277		PO($ropts, 'xfield', '1');
278		P("yfield: $field");
279		P("linedetails: color=${$ropts->{-colorsarrayref}}[$i]");
280		if (defined($ropts->{-labelsarrayref})) {
281			P("legendlabel: ${$ropts->{-labelsarrayref}}[$i]");
282		}
283	}
284	P("gapmissing: yes");
285}
286
287sub Ploticus_lines_stacked {
288	my $cloneref = shift;
289	my $labelsarrayref = shift;
290	my $colorsarrayref = shift;
291	my $indexesarrayref = shift;
292	my $field;
293	foreach my $i (@$indexesarrayref) {
294		my $field = $i+2;
295		P("#proc bars");
296		&$cloneref if defined($cloneref);
297		P("lenfield: $field");
298		P("color: $colorsarrayref->[$i]");
299		P("legendlabel: $labelsarrayref->[$i]");
300	}
301}
302
303sub Ploticus_xaxis {
304	my $ropts = shift;
305	my $window = $ropts->{-window};
306	my $TZ = POSIX::strftime "%Z", localtime(time);
307	P("#proc xaxis");
308	if (!defined($window)) {
309		P("stubs: inc");
310	} elsif ($window >= 3*24*3600) {
311		P("stubs: inc 1 day");
312		P("stubformat: Mmmdd");
313		P("stubround: day");
314		P("label: Date");
315	} elsif ($window > 8*3600) {
316		if (defined($ropts->{-mini})) {
317		P("stubs: inc 4 hours");
318		} else {
319		P("stubs: inc 2 hours");
320		}
321		P("autodays: yes");
322		P("stubround: hour");
323		P("stubformat: hh:mm");
324		P("label: Time, $TZ");
325	} elsif ($window > 2*3600) {
326		P("stubs: inc 30 minutes");
327		P("stubformat: hh:mm");
328		P("label: Time, $TZ");
329	} else {
330		P("stubs: inc 10 minutes");
331		P("stubformat: hh:mm");
332		P("label: Time, $TZ");
333	}
334	PO($ropts, 'label');
335	PO($ropts, 'grid');
336	PO($ropts, 'stubcull');
337}
338
339sub Ploticus_yaxis{
340	my $ropts = shift;
341	P("#proc yaxis");
342	PO($ropts, 'stubs', 'inc');
343	PO($ropts, 'grid');
344	PO($ropts, 'label');
345}
346
347sub Ploticus_legend {
348	my $ropts = shift;
349	P("#proc legend");
350	PO($ropts, 'location', 'max+0.5 max');
351	PO($ropts, 'reverseorder', 'yes');
352	P("outlinecolors: yes");
353}
354
355sub Ploticus_categories {
356	my $catfield = shift;
357	P("#proc categories");
358	P("axis: y");
359	P("datafield: $catfield");
360}
361
362sub Ploticus_legendentry {
363	my $ropts = shift;
364	P("#proc legendentry");
365	P("sampletype: color");
366	PO($ropts, 'label');
367	PO($ropts, 'details');
368	PO($ropts, 'tag');
369}
370
371sub Ploticus_annotate {
372	my $ropts = shift;
373	P("#proc annotate");
374	PO($ropts, 'textdetails');
375	PO($ropts, 'location');
376	PO($ropts, 'text');
377	P("");
378}
379
380sub window2increment {
381	my $window = shift;
382	return 10*60 if ($window == 3600);
383	return 30*60 if ($window == 4*3600);
384	return 2*3600 if ($window == 24*3600);
385	return 24*3600 if ($window == 7*24*3600);
386	warn "window2increment: bad window value $window";
387	undef;
388}
389
390sub extract_server_from_datafile_path {
391	my $fn = shift;
392	die "$fn" unless ($fn =~ m@/([^/]+)/[^/]+/\d\d\d\d\d\d\d\d/@);
393	return $1;
394}
395
396sub extract_node_from_datafile_path {
397	my $fn = shift;
398	die "$fn" unless ($fn =~ m@/[^/]+/([^/]+)/\d\d\d\d\d\d\d\d/@);
399	return $1;
400}
401
402sub index_in_array {
403	my $arrayref = shift;
404	my $val = shift;
405	for(my $i=0; $i<@$arrayref; $i++) {
406		return $i if ($arrayref->[$i] eq $val);
407	}
408	-1;
409}
410
411sub PO {
412	my $ropts = shift;
413	my $optname = shift;
414	my $default = shift;
415	if (defined ($ropts->{-$optname})) {
416		P("$optname: $ropts->{-$optname}");
417	} elsif (defined($default)) {
418		P("$optname: $default");
419	}
420}
421
422sub P {
423	my $line = shift;
424	print STDERR "$line\n" if ($main::ploticus_debug);
425	ploticus_execline($line);
426}
427
428
429###### The following routines mimick the old Chart::Ploticus
430
431my $ploticus_state = 0;
432my $ploticus_type = undef;
433my $ploticus_output = undef;
434my %ploticus_args;
435
436sub ploticus_init {
437	die "wrong state" unless (0 == $ploticus_state);
438	$ploticus_type = shift or die;
439	$ploticus_output = shift or die;
440	undef %ploticus_args;
441	$ploticus_state = 1;
442}
443
444sub ploticus_arg {
445	die "wrong state" unless (1 == $ploticus_state);
446	my $k = shift;
447	my $v = shift;
448	$ploticus_args{$k} = $v;
449}
450
451sub ploticus_begin {
452	die "wrong state" unless (1 == $ploticus_state);
453	my $prog = (grep {-f $_} qw(/usr/local/bin/ploticus /usr/local/bin/pl /usr/bin/ploticus /usr/bin/pl))[0];
454	die 'no ploticus program' unless $prog;
455	my $cmd = join(" ",
456		$prog,
457		"-stdin",
458		(map { "$_ $ploticus_args{$_}" } keys %ploticus_args),
459		"-$ploticus_type",
460		"-pagesize 12,12",
461		"-o $ploticus_output");
462	print STDERR "$cmd\n" if ($main::ploticus_debug);
463	open(PLOTICUS, "|$cmd") or die "$cmd";
464	$ploticus_state = 2;
465}
466
467sub ploticus_execline {
468	die "wrong state" unless (2 == $ploticus_state);
469	my $line = shift;
470	$line =~ s/\n/\\n/g;
471	print PLOTICUS $line, "\n"
472}
473
474sub ploticus_end {
475	die "wrong state" unless (2 == $ploticus_state);
476	close(PLOTICUS) or die "close";
477	$ploticus_state = 0;
478}
479
480
4811;
482