1 # Copyright (C) 2002 Stanislav Sinyagin
3 # This program is free software; you can redistribute it and/or modify
4 # it under the terms of the GNU General Public License as published by
5 # the Free Software Foundation; either version 2 of the License, or
6 # (at your option) any later version.
8 # This program is distributed in the hope that it will be useful,
9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 # GNU General Public License for more details.
13 # You should have received a copy of the GNU General Public License
14 # along with this program; if not, write to the Free Software
15 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
17 # $Id: RRDtool.pm,v 1.1 2010-12-27 00:03:44 ivan Exp $
18 # Stanislav Sinyagin <ssinyagin@yahoo.com>
20 package Torrus::Renderer::RRDtool;
24 use Torrus::ConfigTree;
30 # All our methods are imported by Torrus::Renderer;
37 'height' => '--height'
40 my @arg_arrays = qw(opts defs bg hwtick hrule hwline line fg);
46 my $config_tree = shift;
51 if( not $config_tree->isLeaf($token) )
53 Error("Token $token is not a leaf");
57 my $obj = {'args' => {}, 'dname' => 'A'};
59 foreach my $arrayName ( @arg_arrays )
61 $obj->{'args'}{$arrayName} = [];
64 push( @{$obj->{'args'}{'opts'}},
65 $self->rrd_make_opts( $config_tree, $token, $view,
66 \%rrd_graph_opts, ) );
68 push( @{$obj->{'args'}{'opts'}},
69 $self->rrd_make_graph_opts( $config_tree, $token, $view ) );
71 my $dstype = $config_tree->getNodeParam($token, 'ds-type');
73 if( $dstype eq 'rrd-multigraph' )
75 $self->rrd_make_multigraph( $config_tree, $token, $view, $obj );
79 my $leaftype = $config_tree->getNodeParam($token, 'leaf-type');
81 # Handle DEFs and CDEFs
82 # At the moment, we call the DEF as 'A'. Could change in the future
83 if( $leaftype eq 'rrd-def' )
85 push( @{$obj->{'args'}{'defs'}},
86 $self->rrd_make_def( $config_tree, $token,
89 if( $self->rrd_check_hw( $config_tree, $token, $view ) )
91 $self->rrd_make_holtwinters( $config_tree, $token,
95 elsif( $leaftype eq 'rrd-cdef' )
97 my $expr = $config_tree->getNodeParam($token, 'rpn-expr');
98 push( @{$obj->{'args'}{'defs'}},
99 $self->rrd_make_cdef($config_tree, $token,
100 $obj->{'dname'}, $expr) );
104 Error("Unsupported leaf-type: $leaftype");
108 $self->rrd_make_graphline( $config_tree, $token, $view, $obj );
111 $self->rrd_make_hrules( $config_tree, $token, $view, $obj );
112 if( not $Torrus::Renderer::ignoreDecorations )
114 $self->rrd_make_decorations( $config_tree, $token, $view, $obj );
121 foreach my $arrayName ( @arg_arrays )
123 push( @args, @{$obj->{'args'}{$arrayName}} );
125 Debug("RRDs::graph arguments: " . join(' ', @args));
128 &RRDs::graph( $outfile, @args );
133 my $path = $config_tree->path($token);
134 Error("$path $view: Error during RRD graph: $ERR");
138 return( $config_tree->getParam($view, 'expires')+time(), 'image/png' );
144 'start' => '--start',
153 my $config_tree = shift;
158 if( not $config_tree->isLeaf($token) )
160 Error("Token $token is not a leaf");
168 push( @arg_opts, $self->rrd_make_opts( $config_tree, $token, $view,
169 \%rrd_print_opts, ) );
171 my $dstype = $config_tree->getNodeParam($token, 'ds-type');
173 if( $dstype eq 'rrd-multigraph' )
175 Error("View type rrprint is not supported ".
176 "for DS type rrd-multigraph");
180 my $leaftype = $config_tree->getNodeParam($token, 'leaf-type');
182 # Handle DEFs and CDEFs
183 # At the moment, we call the DEF as 'A'. Could change in the future
185 if( $leaftype eq 'rrd-def' )
188 $self->rrd_make_def( $config_tree, $token, $dname ) );
190 elsif( $leaftype eq 'rrd-cdef' )
192 my $expr = $config_tree->getNodeParam($token, 'rpn-expr');
194 $self->rrd_make_cdef($config_tree, $token, $dname, $expr) );
198 Error("Unsupported leaf-type: $leaftype");
202 foreach my $cf ( split(',', $config_tree->getParam($view, 'print-cf')) )
204 push( @arg_print, sprintf( 'PRINT:%s:%s:%%le', $dname, $cf ) );
209 my @args = ( @arg_opts, @arg_defs, @arg_print );
210 Debug("RRDs::graph arguments: " . join(' ', @args));
214 ($printout, undef, undef) = RRDs::graph('/dev/null', @args);
219 my $path = $config_tree->path($token);
220 Error("$path $view: Error during RRD graph: $ERR");
224 if( not open(OUT, ">$outfile") )
226 Error("Cannot open $outfile for writing: $!");
231 printf OUT ("%s\n", join(':', @{$printout}));
235 return( $config_tree->getParam($view, 'expires')+time(), 'text/plain' );
240 sub rrd_make_multigraph
243 my $config_tree = shift;
249 split(',', $config_tree->getNodeParam($token, 'ds-names') );
251 # We need this to refer to some existing variable name
252 $obj->{'dname'} = $dsNames[0];
254 # Analyze the drawing order
256 foreach my $dname ( @dsNames )
258 my $order = $config_tree->getNodeParam($token, 'line-order-'.$dname);
259 $dsOrder{$dname} = defined( $order ) ? $order : 100;
262 my $disable_legend = $config_tree->getParam($view, 'disable-legend');
264 (defined($disable_legend) and $disable_legend eq 'yes') ? 1:0;
266 # make DEFs and Line instructions
270 if( not $disable_legend )
272 $do_gprint = $self->rrd_if_gprint( $config_tree, $token );
275 $self->rrd_make_gprint_header( $config_tree, $token, $view, $obj );
279 foreach my $dname ( sort {$dsOrder{$a} <=> $dsOrder{$b}} @dsNames )
283 $config_tree->getNodeParam($token, 'ignore-views-'.$dname);
284 if( defined( $ignoreViews ) and
285 grep {$_ eq $view} split(',', $ignoreViews) )
290 my $gprint_this = $do_gprint;
294 $config_tree->getNodeParam($token, 'disable-gprint-'.$dname);
295 if( defined( $ds_nogprint ) and $ds_nogprint eq 'yes' )
303 if( $dograph or $gprint_this )
305 my $expr = $config_tree->getNodeParam($token, 'ds-expr-'.$dname);
306 push( @{$obj->{'args'}{'defs'}},
307 $self->rrd_make_cdef($config_tree, $token, $dname, $expr) );
310 $config_tree->getNodeParam($token, 'graph-legend-'.$dname);
311 if( defined( $legend ) )
313 $legend =~ s/:/\\:/g;
323 $self->rrd_make_gprint( $dname, $legend,
324 $config_tree, $token, $view, $obj );
327 push( @{$obj->{'args'}{'line'}},
328 'COMMENT:' . $legend . '\l');
333 # For datasource that disables gprint, there's no reason
341 $self->mkline( $config_tree->getNodeParam
342 ($token, 'line-style-'.$dname) );
345 $self->mkcolor( $config_tree->getNodeParam
346 ($token, 'line-color-'.$dname) );
349 $config_tree->getNodeParam($token, 'line-alpha-'.$dname);
350 if( defined( $alpha ) )
352 $linecolor .= $alpha;
356 $config_tree->getNodeParam($token, 'line-stack-'.$dname);
357 if( defined( $stack ) and $stack eq 'yes' )
366 push( @{$obj->{'args'}{'line'}},
367 sprintf( '%s:%s%s%s%s', $linestyle, $dname,
369 length($legend) > 0 ? ':'.$legend.'\l' : '',
377 # Check if Holt-Winters stuff is needed
381 my $config_tree = shift;
386 my $nodeHW = $config_tree->getNodeParam($token, 'rrd-hwpredict');
387 if( defined($nodeHW) and $nodeHW eq 'enabled' )
389 my $viewHW = $config_tree->getParam($view, 'rrd-hwpredict');
390 my $varNoHW = $self->{'options'}->{'variables'}->{'NOHW'};
392 if( (not defined($viewHW) or $viewHW ne 'disabled') and
402 sub rrd_make_holtwinters
405 my $config_tree = shift;
410 my $dname = $obj->{'dname'};
412 push( @{$obj->{'args'}{'defs'}},
413 $self->rrd_make_def( $config_tree, $token,
414 $dname . 'pred', 'HWPREDICT' ) );
415 push( @{$obj->{'args'}{'defs'}},
416 $self->rrd_make_def( $config_tree, $token,
417 $dname . 'dev', 'DEVPREDICT' ) );
418 # Upper boundary definition
419 push( @{$obj->{'args'}{'defs'}},
420 sprintf( 'CDEF:%supper=%spred,%sdev,2,*,+',
421 $dname, $dname, $dname ) );
423 # Lower boundary definition
424 push( @{$obj->{'args'}{'defs'}},
425 sprintf( 'CDEF:%slower=%spred,%sdev,2,*,-',
426 $dname, $dname, $dname ) );
428 # Failures definition
429 push( @{$obj->{'args'}{'defs'}},
430 $self->rrd_make_def( $config_tree, $token,
431 $dname . 'fail', 'FAILURES' ) );
433 # Generate H-W Boundary Lines
436 my $hw_bndr_style = $config_tree->getParam($view, 'hw-bndr-style');
437 $hw_bndr_style = 'LINE1' unless defined $hw_bndr_style;
438 $hw_bndr_style = $self->mkline( $hw_bndr_style );
440 my $hw_bndr_color = $config_tree->getParam($view, 'hw-bndr-color');
441 $hw_bndr_color = '#FF0000' unless defined $hw_bndr_color;
442 $hw_bndr_color = $self->mkcolor( $hw_bndr_color );
444 push( @{$obj->{'args'}{'hwline'}},
445 sprintf( '%s:%supper%s:%s',
446 $hw_bndr_style, $dname, $hw_bndr_color,
447 $Torrus::Renderer::hwGraphLegend ? 'Boundaries\n':'' ) );
448 push( @{$obj->{'args'}{'hwline'}},
449 sprintf( '%s:%slower%s',
450 $hw_bndr_style, $dname, $hw_bndr_color ) );
454 my $hw_fail_color = $config_tree->getParam($view, 'hw-fail-color');
455 $hw_fail_color = '#FFFFA0' unless defined $hw_fail_color;
456 $hw_fail_color = $self->mkcolor( $hw_fail_color );
458 push( @{$obj->{'args'}{'hwtick'}},
459 sprintf( 'TICK:%sfail%s:1.0:%s',
460 $dname, $hw_fail_color,
461 $Torrus::Renderer::hwGraphLegend ? 'Failures':'') );
464 sub rrd_make_graphline
467 my $config_tree = shift;
474 my $disable_legend = $config_tree->getParam($view, 'disable-legend');
475 if( not defined($disable_legend) or $disable_legend ne 'yes' )
477 $legend = $config_tree->getNodeParam($token, 'graph-legend');
478 if( defined( $legend ) )
480 $legend =~ s/:/\\:/g;
484 if( not defined( $legend ) )
489 my $styleval = $config_tree->getNodeParam($token, 'line-style');
490 if( not defined( $styleval ) or length( $styleval ) == 0 )
492 $styleval = $config_tree->getParam($view, 'line-style');
495 my $linestyle = $self->mkline( $styleval );
497 my $colorval = $config_tree->getNodeParam($token, 'line-color');
498 if( not defined( $colorval ) or length( $colorval ) == 0 )
500 $colorval = $config_tree->getParam($view, 'line-color');
503 my $linecolor = $self->mkcolor( $colorval );
505 if( $self->rrd_if_gprint( $config_tree, $token ) )
507 $self->rrd_make_gprint_header( $config_tree, $token, $view, $obj );
509 $self->rrd_make_gprint( $obj->{'dname'}, $legend,
510 $config_tree, $token, $view, $obj );
513 push( @{$obj->{'args'}{'line'}},
514 sprintf( '%s:%s%s%s', $linestyle, $obj->{'dname'}, $linecolor,
515 length($legend) > 0 ? ':'.$legend.'\l' : '' ) );
519 # Generate RRDtool arguments for HRULE's
524 my $config_tree = shift;
529 my $hrulesList = $config_tree->getParam($view, 'hrules');
530 if( defined( $hrulesList ) )
532 foreach my $hruleName ( split(',', $hrulesList ) )
534 # The presence of this parameter is checked by Validator
536 $config_tree->getParam( $view, 'hrule-value-'.$hruleName );
537 my $value = $config_tree->getNodeParam( $token, $valueParam );
539 if( defined( $value ) )
542 $config_tree->getParam($view, 'hrule-color-'.$hruleName);
543 $color = $self->mkcolor( $color );
546 $config_tree->getNodeParam($token,
547 'hrule-legend-'.$hruleName);
549 my $arg = sprintf( 'HRULE:%e%s', $value, $color );
550 if( defined( $legend ) and $legend =~ /\S/ )
552 $arg .= ':' . $legend . '\l';
554 push( @{$obj->{'args'}{'hrule'}}, $arg );
561 sub rrd_make_decorations
564 my $config_tree = shift;
569 my $decorList = $config_tree->getParam($view, 'decorations');
571 $config_tree->getNodeParam($token, 'graph-ignore-decorations');
572 if( defined( $decorList ) and
573 (not defined($ignore_decor) or $ignore_decor ne 'yes') )
576 foreach my $decorName ( split(',', $decorList ) )
579 $config_tree->getParam($view, 'dec-order-' . $decorName);
580 $decor->{$order} = {'def' => [], 'line' => ''};
583 $self->mkline( $config_tree->
584 getParam($view, 'dec-style-' . $decorName) );
586 $self->mkcolor( $config_tree->
587 getParam($view, 'dec-color-' . $decorName) );
588 my $expr = $config_tree->
589 getParam($view, 'dec-expr-' . $decorName);
591 push( @{$decor->{$order}{'def'}},
592 $self->rrd_make_cdef( $config_tree, $token, $decorName,
593 $obj->{'dname'} . ',POP,' . $expr ) );
595 $decor->{$order}{'line'} =
596 sprintf( '%s:%s%s', $style, $decorName, $color );
599 foreach my $order ( sort {$a<=>$b} keys %{$decor} )
601 my $array = $order < 0 ? 'bg':'fg';
603 push( @{$obj->{'args'}{'defs'}}, @{$decor->{$order}{'def'}} );
604 push( @{$obj->{'args'}{$array}}, $decor->{$order}{'line'} );
609 # Takes the parameters from the view, and composes the list of
615 my $config_tree = shift;
621 foreach my $param ( keys %{$opthash} )
624 $self->{'options'}->{'variables'}->{'G' . $param};
626 if( not defined( $value ) )
628 $value = $config_tree->getParam( $view, $param );
631 if( defined( $value ) )
633 if( ( $param eq 'start' or $param eq 'end' ) and
634 defined( $self->{'options'}->{'variables'}->{'NOW'} ) )
636 my $now = $self->{'options'}->{'variables'}->{'NOW'};
637 if( index( $value , 'now' ) >= 0 )
639 $value =~ s/now/$now/;
641 elsif( $value =~ /^(\-|\+)/ )
643 $value = $now . $value;
646 push( @args, $opthash->{$param}, $value );
650 my $params = $config_tree->getParam($view, 'rrd-params');
651 if( defined( $params ) )
653 push( @args, split('\s+', $params) );
656 my $scalingbase = $config_tree->getNodeParam($token, 'rrd-scaling-base');
657 if( defined($scalingbase) and $scalingbase == 1024 )
659 push( @args, '--base', '1024' );
666 sub rrd_make_graph_opts
669 my $config_tree = shift;
673 my @args = ( '--imgformat', 'PNG' );
675 my $graph_log = $config_tree->getNodeParam($token, 'graph-logarithmic');
676 if( defined($graph_log) and $graph_log eq 'yes' )
678 push( @args, '--logarithmic' );
682 $config_tree->getParam($view, 'disable-title');
683 if( not defined( $disable_title ) or $disable_title ne 'yes' )
685 my $title = $config_tree->getNodeParam($token, 'graph-title');
686 if( not defined( $title ) or length( $title ) == 0 )
690 push( @args, '--title', $title );
694 $config_tree->getParam($view, 'disable-vertical-label');
695 if( not defined( $disable_vlabel ) or $disable_vlabel ne 'yes' )
698 $config_tree->getNodeParam($token, 'vertical-label');
699 if( defined( $vertical_label ) and length( $vertical_label ) > 0 )
701 push( @args, '--vertical-label', $vertical_label );
705 my $ignore_limits = $config_tree->getParam($view, 'ignore-limits');
706 if( not defined($ignore_limits) or $ignore_limits ne 'yes' )
708 my $ignore_lower = $config_tree->getParam($view, 'ignore-lower-limit');
709 if( not defined($ignore_lower) or $ignore_lower ne 'yes' )
712 $config_tree->getNodeParam($token, 'graph-lower-limit');
713 if( defined($limit) and length( $limit ) > 0 )
715 push( @args, '--lower-limit', $limit );
719 my $ignore_upper = $config_tree->getParam($view, 'ignore-upper-limit');
720 if( not defined($ignore_upper) or $ignore_upper ne 'yes' )
723 $config_tree->getNodeParam($token, 'graph-upper-limit');
724 if( defined($limit) and length( $limit ) > 0 )
726 push( @args, '--upper-limit', $limit );
730 my $rigid_boundaries =
731 $config_tree->getNodeParam($token, 'graph-rigid-boundaries');
732 if( defined($rigid_boundaries) and $rigid_boundaries eq 'yes' )
734 push( @args, '--rigid' );
738 if( scalar( @Torrus::Renderer::graphExtraArgs ) > 0 )
740 push( @args, @Torrus::Renderer::graphExtraArgs );
750 my $config_tree = shift;
755 my $datafile = $config_tree->getNodeParam($token, 'data-file');
756 my $dataddir = $config_tree->getNodeParam($token, 'data-dir');
757 my $rrdfile = $dataddir.'/'.$datafile;
758 if( not -r $rrdfile )
760 my $path = $config_tree->path($token);
761 Error("$path: No such file or directory: $rrdfile");
765 my $ds = $config_tree->getNodeParam($token, 'rrd-ds');
766 if( not defined $cf )
768 $cf = $config_tree->getNodeParam($token, 'rrd-cf');
770 return sprintf( 'DEF:%s=%s:%s:%s',
771 $dname, $rrdfile, $ds, $cf );
782 # Moved the validation part to Torrus::ConfigTree::Validator
786 my $config_tree = shift;
793 # We will name the DEFs as $dname.sprintf('%.2d', $ds_couter++);
796 my $rpn = new Torrus::RPN;
798 # The callback for RPN translation
801 my ($noderef, $timeoffset) = @_;
804 if( $noderef =~ s/^(.+)\@// )
810 if( defined( $function ) and $cfNames{$function} )
815 my $leaf = length($noderef) > 0 ?
816 $config_tree->getRelative($token, $noderef) : $token;
818 my $varname = $dname . sprintf('%.2d', $ds_couter++);
820 $self->rrd_make_def( $config_tree, $leaf, $varname, $cf ) );
824 $expr = $rpn->translate( $expr, $callback );
825 push( @args, sprintf( 'CDEF:%s=%s', $dname, $expr ) );
833 my $config_tree = shift;
836 my $disable = $config_tree->getNodeParam($token, 'graph-disable-gprint');
837 if( defined( $disable ) and $disable eq 'yes' )
849 my $config_tree = shift;
856 my $gprintValues = $config_tree->getParam($view, 'gprint-values');
857 if( defined( $gprintValues ) and length( $gprintValues ) > 0 )
859 foreach my $gprintVal ( split(',', $gprintValues ) )
862 $config_tree->getParam($view, 'gprint-format-' . $gprintVal);
863 push( @args, 'GPRINT:' . $vname . ':' . $format );
867 push( @{$obj->{'args'}{'line'}}, @args );
871 sub rrd_make_gprint_header
874 my $config_tree = shift;
879 my $gprintValues = $config_tree->getParam($view, 'gprint-values');
880 if( defined( $gprintValues ) and length( $gprintValues ) > 0 )
882 my $gprintHeader = $config_tree->getParam($view, 'gprint-header');
883 if( defined( $gprintHeader ) and length( $gprintHeader ) > 0 )
885 push( @{$obj->{'args'}{'line'}},
886 'COMMENT:' . $gprintHeader . '\l' );
897 my $recursionLimit = 100;
899 while( $color =~ /^\#\#(\S+)$/ )
901 if( $recursionLimit-- <= 0 )
903 Error('Color recursion is too deep');
909 $color = $Torrus::Renderer::graphStyles{$colorName}{'color'};
910 if( not defined( $color ) )
912 Error('No color is defined for ' . $colorName);
925 if( $line =~ /^\#\#(\S+)$/ )
928 $line = $Torrus::Renderer::graphStyles{$lineName}{'line'};
929 if( not defined( $line ) )
931 Error('No line style is defined for ' . $lineName);
943 if( defined $ENV{'TZ'} )
945 Debug("Previous TZ value: " . $ENV{'TZ'});
946 $self->{'tz_defined'} = 1;
950 $self->{'tz_defined'} = 0;
953 if( defined( my $newTZ = $self->{'options'}->{'variables'}->{'TZ'} ) )
955 Debug("Setting TZ to " . $newTZ);
956 $self->{'tz_old'} = $ENV{'TZ'};
958 $self->{'tz_changed'} = 1;
962 $self->{'tz_changed'} = 0;
970 if( $self->{'tz_changed'} )
972 if( $self->{'tz_defined'} )
974 Debug("Restoring TZ back to " . $self->{'tz_old'});
975 $ENV{'TZ'} = $self->{'tz_old'};
979 Debug("Restoring TZ back to undefined");
991 # indent-tabs-mode: nil
992 # perl-indent-level: 4