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