torrus/perllib/Torrus/Renderer/RRDtool.pm

   1 #  Copyright (C) 2002  Stanislav Sinyagin
   2 #
   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.
   7 #
   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.
  12 #
  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.
  16
  17 # $Id: RRDtool.pm,v 1.1 2010-12-27 00:03:44 ivan Exp $
  18 # Stanislav Sinyagin <ssinyagin@yahoo.com>
  19
  20 package Torrus::Renderer::RRDtool;
  21
  22 use strict;
  23
  24 use Torrus::ConfigTree;
  25 use Torrus::RPN;
  26 use Torrus::Log;
  27
  28 use RRDs;
  29
  30 # All our methods are imported by Torrus::Renderer;
  31
  32 my %rrd_graph_opts =
  33     (
  34      'start'  => '--start',
  35      'end'    => '--end',
  36      'width'  => '--width',
  37      'height' => '--height'
  38      );
  39
  40 my @arg_arrays = qw(opts defs bg hwtick hrule hwline line fg);
  41
  42
  43 sub render_rrgraph
  44 {
  45     my $self = shift;
  46     my $config_tree = shift;
  47     my $token = shift;
  48     my $view = shift;
  49     my $outfile = shift;
  50
  51     if( not $config_tree->isLeaf($token) )
  52     {
  53         Error("Token $token is not a leaf");
  54         return undef;
  55     }
  56
  57     my $obj = {'args' => {}, 'dname' => 'A'};
  58
  59     foreach my $arrayName ( @arg_arrays )
  60     {
  61         $obj->{'args'}{$arrayName} = [];
  62     }
  63
  64     push( @{$obj->{'args'}{'opts'}},
  65           $self->rrd_make_opts( $config_tree, $token, $view,
  66                                 \%rrd_graph_opts, ) );
  67
  68     push( @{$obj->{'args'}{'opts'}},
  69           $self->rrd_make_graph_opts( $config_tree, $token, $view ) );
  70
  71     my $dstype = $config_tree->getNodeParam($token, 'ds-type');
  72
  73     if( $dstype eq 'rrd-multigraph' )
  74     {
  75         $self->rrd_make_multigraph( $config_tree, $token, $view, $obj );
  76     }
  77     else
  78     {
  79         my $leaftype = $config_tree->getNodeParam($token, 'leaf-type');
  80
  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' )
  84         {
  85             push( @{$obj->{'args'}{'defs'}},
  86                   $self->rrd_make_def( $config_tree, $token,
  87                                        $obj->{'dname'} ) );
  88
  89             if( $self->rrd_check_hw( $config_tree, $token, $view ) )
  90             {
  91                 $self->rrd_make_holtwinters( $config_tree, $token,
  92                                              $view, $obj );
  93             }
  94         }
  95         elsif( $leaftype eq 'rrd-cdef' )
  96         {
  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) );
 101         }
 102         else
 103         {
 104             Error("Unsupported leaf-type: $leaftype");
 105             return undef;
 106         }
 107
 108         $self->rrd_make_graphline( $config_tree, $token, $view, $obj );
 109     }
 110
 111     $self->rrd_make_hrules( $config_tree, $token, $view, $obj );
 112     if( not $Torrus::Renderer::ignoreDecorations )
 113     {
 114         $self->rrd_make_decorations( $config_tree, $token, $view, $obj );
 115     }
 116
 117     # We're all set
 118
 119
 120     my @args;
 121     foreach my $arrayName ( @arg_arrays )
 122     {
 123         push( @args, @{$obj->{'args'}{$arrayName}} );
 124     }
 125     Debug("RRDs::graph arguments: " . join(' ', @args));
 126
 127     $self->tz_set();
 128     &RRDs::graph( $outfile, @args );
 129     $self->tz_restore();
 130     my $ERR=RRDs::error;
 131     if( $ERR )
 132     {
 133         my $path = $config_tree->path($token);
 134         Error("$path $view: Error during RRD graph: $ERR");
 135         return undef;
 136     }
 137
 138     return( $config_tree->getParam($view, 'expires')+time(), 'image/png' );
 139 }
 140
 141
 142 my %rrd_print_opts =
 143     (
 144      'start'  => '--start',
 145      'end'    => '--end',
 146      );
 147
 148
 149
 150 sub render_rrprint
 151 {
 152     my $self = shift;
 153     my $config_tree = shift;
 154     my $token = shift;
 155     my $view = shift;
 156     my $outfile = shift;
 157
 158     if( not $config_tree->isLeaf($token) )
 159     {
 160         Error("Token $token is not a leaf");
 161         return undef;
 162     }
 163
 164     my @arg_opts;
 165     my @arg_defs;
 166     my @arg_print;
 167
 168     push( @arg_opts, $self->rrd_make_opts( $config_tree, $token, $view,
 169                                            \%rrd_print_opts, ) );
 170
 171     my $dstype = $config_tree->getNodeParam($token, 'ds-type');
 172
 173     if( $dstype eq 'rrd-multigraph' )
 174     {
 175         Error("View type rrprint is not supported ".
 176               "for DS type rrd-multigraph");
 177         return undef;
 178     }
 179
 180     my $leaftype = $config_tree->getNodeParam($token, 'leaf-type');
 181
 182     # Handle DEFs and CDEFs
 183     # At the moment, we call the DEF as 'A'. Could change in the future
 184     my $dname = 'A';
 185     if( $leaftype eq 'rrd-def' )
 186     {
 187         push( @arg_defs,
 188               $self->rrd_make_def( $config_tree, $token, $dname ) );
 189     }
 190     elsif( $leaftype eq 'rrd-cdef' )
 191     {
 192         my $expr = $config_tree->getNodeParam($token, 'rpn-expr');
 193         push( @arg_defs,
 194               $self->rrd_make_cdef($config_tree, $token, $dname, $expr) );
 195     }
 196     else
 197     {
 198         Error("Unsupported leaf-type: $leaftype");
 199         return undef;
 200     }
 201
 202     foreach my $cf ( split(',', $config_tree->getParam($view, 'print-cf')) )
 203     {
 204         push( @arg_print, sprintf( 'PRINT:%s:%s:%%le', $dname, $cf ) );
 205     }
 206
 207     # We're all set
 208
 209     my @args = ( @arg_opts, @arg_defs, @arg_print );
 210     Debug("RRDs::graph arguments: " . join(' ', @args));
 211
 212     my $printout;
 213     $self->tz_set();
 214     ($printout, undef, undef) = RRDs::graph('/dev/null', @args);
 215     $self->tz_restore();
 216     my $ERR=RRDs::error;
 217     if( $ERR )
 218     {
 219         my $path = $config_tree->path($token);
 220         Error("$path $view: Error during RRD graph: $ERR");
 221         return undef;
 222     }
 223
 224     if( not open(OUT, ">$outfile") )
 225     {
 226         Error("Cannot open $outfile for writing: $!");
 227         return undef;
 228     }
 229     else
 230     {
 231         printf OUT ("%s\n", join(':', @{$printout}));
 232         close OUT;
 233     }
 234
 235     return( $config_tree->getParam($view, 'expires')+time(), 'text/plain' );
 236 }
 237
 238
 239
 240 sub rrd_make_multigraph
 241 {
 242     my $self = shift;
 243     my $config_tree = shift;
 244     my $token = shift;
 245     my $view = shift;
 246     my $obj = shift;
 247
 248     my @dsNames =
 249         split(',', $config_tree->getNodeParam($token, 'ds-names') );
 250
 251     # We need this to refer to some existing variable name
 252     $obj->{'dname'} = $dsNames[0];
 253
 254     # Analyze the drawing order
 255     my %dsOrder;
 256     foreach my $dname ( @dsNames )
 257     {
 258         my $order = $config_tree->getNodeParam($token, 'line-order-'.$dname);
 259         $dsOrder{$dname} = defined( $order ) ? $order : 100;
 260     }
 261
 262     my $disable_legend = $config_tree->getParam($view, 'disable-legend');
 263     $disable_legend =
 264         (defined($disable_legend) and $disable_legend eq 'yes') ? 1:0;
 265
 266     # make DEFs and Line instructions
 267
 268     my $do_gprint = 0;
 269
 270     if( not $disable_legend )
 271     {
 272         $do_gprint = $self->rrd_if_gprint( $config_tree, $token );
 273         if( $do_gprint )
 274         {
 275             $self->rrd_make_gprint_header( $config_tree, $token, $view, $obj );
 276         }
 277     }
 278
 279     foreach my $dname ( sort {$dsOrder{$a} <=> $dsOrder{$b}} @dsNames )
 280     {
 281         my $dograph = 1;
 282         my $ignoreViews =
 283             $config_tree->getNodeParam($token, 'ignore-views-'.$dname);
 284         if( defined( $ignoreViews ) and
 285             grep {$_ eq $view} split(',', $ignoreViews) )
 286         {
 287             $dograph = 0;
 288         }
 289
 290         my $gprint_this = $do_gprint;
 291         if( $do_gprint )
 292         {
 293             my $ds_nogprint =
 294                 $config_tree->getNodeParam($token, 'disable-gprint-'.$dname);
 295             if( defined( $ds_nogprint ) and $ds_nogprint eq 'yes' )
 296             {
 297                 $gprint_this = 0;
 298             }
 299         }
 300
 301         my $legend;
 302
 303         if( $dograph or $gprint_this )
 304         {
 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) );
 308
 309             $legend =
 310                 $config_tree->getNodeParam($token, 'graph-legend-'.$dname);
 311             if( defined( $legend ) )
 312             {
 313                 $legend =~ s/:/\\:/g;
 314             }
 315             else
 316             {
 317                 $legend = '';
 318             }
 319         }
 320
 321         if( $gprint_this )
 322         {
 323             $self->rrd_make_gprint( $dname, $legend,
 324                                     $config_tree, $token, $view, $obj );
 325             if( not $dograph )
 326             {
 327                 push( @{$obj->{'args'}{'line'}},
 328                       'COMMENT:' . $legend . '\l');
 329             }
 330         }
 331         else
 332         {
 333             # For datasource that disables gprint, there's no reason
 334             # to print the label
 335             $legend = '';
 336         }
 337
 338         if( $dograph )
 339         {
 340             my $linestyle =
 341                 $self->mkline( $config_tree->getNodeParam
 342                                ($token, 'line-style-'.$dname) );
 343
 344             my $linecolor =
 345                 $self->mkcolor( $config_tree->getNodeParam
 346                                 ($token, 'line-color-'.$dname) );
 347
 348             my $alpha =
 349                 $config_tree->getNodeParam($token, 'line-alpha-'.$dname);
 350             if( defined( $alpha ) )
 351             {
 352                 $linecolor .= $alpha;
 353             }
 354
 355             my $stack =
 356                 $config_tree->getNodeParam($token, 'line-stack-'.$dname);
 357             if( defined( $stack ) and $stack eq 'yes' )
 358             {
 359                 $stack = ':STACK';
 360             }
 361             else
 362             {
 363                 $stack = '';
 364             }
 365
 366             push( @{$obj->{'args'}{'line'}},
 367                   sprintf( '%s:%s%s%s%s', $linestyle, $dname,
 368                            $linecolor,
 369                            length($legend) > 0 ? ':'.$legend.'\l' : '',
 370                            $stack ) );
 371
 372         }
 373     }
 374 }
 375
 376
 377 # Check if Holt-Winters stuff is needed
 378 sub rrd_check_hw
 379 {
 380     my $self = shift;
 381     my $config_tree = shift;
 382     my $token = shift;
 383     my $view = shift;
 384
 385     my $use_hw = 0;
 386     my $nodeHW = $config_tree->getNodeParam($token, 'rrd-hwpredict');
 387     if( defined($nodeHW) and $nodeHW eq 'enabled' )
 388     {
 389         my $viewHW = $config_tree->getParam($view, 'rrd-hwpredict');
 390         my $varNoHW = $self->{'options'}->{'variables'}->{'NOHW'};
 391
 392         if( (not defined($viewHW) or $viewHW ne 'disabled') and
 393             (not $varNoHW) )
 394         {
 395             $use_hw = 1;
 396         }
 397     }
 398     return $use_hw;
 399 }
 400
 401
 402 sub rrd_make_holtwinters
 403 {
 404     my $self = shift;
 405     my $config_tree = shift;
 406     my $token = shift;
 407     my $view = shift;
 408     my $obj = shift;
 409
 410     my $dname = $obj->{'dname'};
 411
 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  ) );
 422
 423     # Lower boundary definition
 424     push( @{$obj->{'args'}{'defs'}},
 425           sprintf( 'CDEF:%slower=%spred,%sdev,2,*,-',
 426                    $dname, $dname, $dname  ) );
 427
 428     # Failures definition
 429     push( @{$obj->{'args'}{'defs'}},
 430           $self->rrd_make_def( $config_tree, $token,
 431                                $dname . 'fail', 'FAILURES' ) );
 432
 433     # Generate H-W Boundary Lines
 434
 435     # Boundary style
 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 );
 439
 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 );
 443
 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 ) );
 451
 452     # Failures Tick
 453
 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 );
 457
 458     push( @{$obj->{'args'}{'hwtick'}},
 459           sprintf( 'TICK:%sfail%s:1.0:%s',
 460                    $dname, $hw_fail_color,
 461                    $Torrus::Renderer::hwGraphLegend ? 'Failures':'') );
 462 }
 463
 464 sub rrd_make_graphline
 465 {
 466     my $self = shift;
 467     my $config_tree = shift;
 468     my $token = shift;
 469     my $view = shift;
 470     my $obj = shift;
 471
 472     my $legend;
 473
 474     my $disable_legend = $config_tree->getParam($view, 'disable-legend');
 475     if( not defined($disable_legend) or $disable_legend ne 'yes' )
 476     {
 477         $legend = $config_tree->getNodeParam($token, 'graph-legend');
 478         if( defined( $legend ) )
 479         {
 480             $legend =~ s/:/\\:/g;
 481         }
 482     }
 483
 484     if( not defined( $legend ) )
 485     {
 486         $legend = '';
 487     }
 488
 489     my $styleval = $config_tree->getNodeParam($token, 'line-style');
 490     if( not defined( $styleval ) or length( $styleval ) == 0 )
 491     {
 492         $styleval = $config_tree->getParam($view, 'line-style');
 493     }
 494
 495     my $linestyle = $self->mkline( $styleval );
 496
 497     my $colorval = $config_tree->getNodeParam($token, 'line-color');
 498     if( not defined( $colorval ) or length( $colorval ) == 0 )
 499     {
 500         $colorval = $config_tree->getParam($view, 'line-color');
 501     }
 502
 503     my $linecolor = $self->mkcolor( $colorval );
 504
 505     if( $self->rrd_if_gprint( $config_tree, $token ) )
 506     {
 507         $self->rrd_make_gprint_header( $config_tree, $token, $view, $obj );
 508
 509         $self->rrd_make_gprint( $obj->{'dname'}, $legend,
 510                                 $config_tree, $token, $view, $obj );
 511     }
 512
 513     push( @{$obj->{'args'}{'line'}},
 514           sprintf( '%s:%s%s%s', $linestyle, $obj->{'dname'}, $linecolor,
 515                    length($legend) > 0 ? ':'.$legend.'\l' : '' ) );
 516 }
 517
 518
 519 # Generate RRDtool arguments for HRULE's
 520
 521 sub rrd_make_hrules
 522 {
 523     my $self = shift;
 524     my $config_tree = shift;
 525     my $token = shift;
 526     my $view = shift;
 527     my $obj = shift;
 528
 529     my $hrulesList = $config_tree->getParam($view, 'hrules');
 530     if( defined( $hrulesList ) )
 531     {
 532         foreach my $hruleName ( split(',', $hrulesList ) )
 533         {
 534             # The presence of this parameter is checked by Validator
 535             my $valueParam =
 536                 $config_tree->getParam( $view, 'hrule-value-'.$hruleName );
 537             my $value = $config_tree->getNodeParam( $token, $valueParam );
 538
 539             if( defined( $value ) )
 540             {
 541                 my $color =
 542                     $config_tree->getParam($view, 'hrule-color-'.$hruleName);
 543                 $color = $self->mkcolor( $color );
 544
 545                 my $legend =
 546                     $config_tree->getNodeParam($token,
 547                                                'hrule-legend-'.$hruleName);
 548
 549                 my $arg = sprintf( 'HRULE:%e%s', $value, $color );
 550                 if( defined( $legend ) and $legend =~ /\S/ )
 551                 {
 552                     $arg .= ':' . $legend . '\l';
 553                 }
 554                 push( @{$obj->{'args'}{'hrule'}}, $arg );
 555             }
 556         }
 557     }
 558 }
 559
 560
 561 sub rrd_make_decorations
 562 {
 563     my $self = shift;
 564     my $config_tree = shift;
 565     my $token = shift;
 566     my $view = shift;
 567     my $obj = shift;
 568
 569     my $decorList = $config_tree->getParam($view, 'decorations');
 570     my $ignore_decor =
 571         $config_tree->getNodeParam($token, 'graph-ignore-decorations');
 572     if( defined( $decorList ) and
 573         (not defined($ignore_decor) or $ignore_decor ne 'yes') )
 574     {
 575         my $decor = {};
 576         foreach my $decorName ( split(',', $decorList ) )
 577         {
 578             my $order =
 579                 $config_tree->getParam($view, 'dec-order-' . $decorName);
 580             $decor->{$order} = {'def' => [], 'line' => ''};
 581
 582             my $style =
 583                 $self->mkline( $config_tree->
 584                                getParam($view, 'dec-style-' . $decorName) );
 585             my $color =
 586                 $self->mkcolor( $config_tree->
 587                                 getParam($view, 'dec-color-' . $decorName) );
 588             my $expr = $config_tree->
 589                 getParam($view, 'dec-expr-' . $decorName);
 590
 591             push( @{$decor->{$order}{'def'}},
 592                   $self->rrd_make_cdef( $config_tree, $token, $decorName,
 593                                         $obj->{'dname'} . ',POP,' . $expr ) );
 594
 595             $decor->{$order}{'line'} =
 596                 sprintf( '%s:%s%s', $style, $decorName, $color );
 597         }
 598
 599         foreach my $order ( sort {$a<=>$b} keys %{$decor} )
 600         {
 601             my $array = $order < 0 ? 'bg':'fg';
 602
 603             push( @{$obj->{'args'}{'defs'}}, @{$decor->{$order}{'def'}} );
 604             push( @{$obj->{'args'}{$array}}, $decor->{$order}{'line'} );
 605         }
 606     }
 607 }
 608
 609 # Takes the parameters from the view, and composes the list of
 610 # RRDtool arguments
 611
 612 sub rrd_make_opts
 613 {
 614     my $self = shift;
 615     my $config_tree = shift;
 616     my $token = shift;
 617     my $view = shift;
 618     my $opthash = shift;
 619
 620     my @args = ();
 621     foreach my $param ( keys %{$opthash} )
 622     {
 623         my $value =
 624             $self->{'options'}->{'variables'}->{'G' . $param};
 625
 626         if( not defined( $value ) )
 627         {
 628             $value = $config_tree->getParam( $view, $param );
 629         }
 630
 631         if( defined( $value ) )
 632         {
 633             if( ( $param eq 'start' or $param eq 'end' ) and
 634                 defined( $self->{'options'}->{'variables'}->{'NOW'} ) )
 635             {
 636                 my $now = $self->{'options'}->{'variables'}->{'NOW'};
 637                 if( index( $value , 'now' ) >= 0 )
 638                 {
 639                     $value =~ s/now/$now/;
 640                 }
 641                 elsif( $value =~ /^(\-|\+)/ )
 642                 {
 643                     $value = $now . $value;
 644                 }
 645             }
 646             push( @args, $opthash->{$param}, $value );
 647         }
 648     }
 649
 650     my $params = $config_tree->getParam($view, 'rrd-params');
 651     if( defined( $params ) )
 652     {
 653         push( @args, split('\s+', $params) );
 654     }
 655
 656     my $scalingbase = $config_tree->getNodeParam($token, 'rrd-scaling-base');
 657     if( defined($scalingbase) and $scalingbase == 1024 )
 658     {
 659         push( @args, '--base', '1024' );
 660     }
 661
 662     return @args;
 663 }
 664
 665
 666 sub rrd_make_graph_opts
 667 {
 668     my $self = shift;
 669     my $config_tree = shift;
 670     my $token = shift;
 671     my $view = shift;
 672
 673     my @args = ( '--imgformat', 'PNG' );
 674
 675     my $graph_log = $config_tree->getNodeParam($token, 'graph-logarithmic');
 676     if( defined($graph_log) and $graph_log eq 'yes' )
 677     {
 678         push( @args, '--logarithmic' );
 679     }
 680
 681     my $disable_title =
 682         $config_tree->getParam($view, 'disable-title');
 683     if( not defined( $disable_title ) or $disable_title ne 'yes' )
 684     {
 685         my $title = $config_tree->getNodeParam($token, 'graph-title');
 686         if( not defined( $title ) or length( $title ) == 0 )
 687         {
 688             $title = ' ';
 689         }
 690         push( @args, '--title', $title );
 691     }
 692
 693     my $disable_vlabel =
 694         $config_tree->getParam($view, 'disable-vertical-label');
 695     if( not defined( $disable_vlabel ) or $disable_vlabel ne 'yes' )
 696     {
 697         my $vertical_label =
 698             $config_tree->getNodeParam($token, 'vertical-label');
 699         if( defined( $vertical_label ) and length( $vertical_label ) > 0 )
 700         {
 701             push( @args, '--vertical-label', $vertical_label );
 702         }
 703     }
 704
 705     my $ignore_limits = $config_tree->getParam($view, 'ignore-limits');
 706     if( not defined($ignore_limits) or $ignore_limits ne 'yes' )
 707     {
 708         my $ignore_lower = $config_tree->getParam($view, 'ignore-lower-limit');
 709         if( not defined($ignore_lower) or $ignore_lower ne 'yes' )
 710         {
 711             my $limit =
 712                 $config_tree->getNodeParam($token, 'graph-lower-limit');
 713             if( defined($limit) and length( $limit ) > 0 )
 714             {
 715                 push( @args, '--lower-limit', $limit );
 716             }
 717         }
 718
 719         my $ignore_upper = $config_tree->getParam($view, 'ignore-upper-limit');
 720         if( not defined($ignore_upper) or $ignore_upper ne 'yes' )
 721         {
 722             my $limit =
 723                 $config_tree->getNodeParam($token, 'graph-upper-limit');
 724             if( defined($limit) and length( $limit ) > 0 )
 725             {
 726                 push( @args, '--upper-limit', $limit );
 727             }
 728         }
 729
 730         my $rigid_boundaries =
 731             $config_tree->getNodeParam($token, 'graph-rigid-boundaries');
 732         if( defined($rigid_boundaries) and $rigid_boundaries eq 'yes' )
 733         {
 734             push( @args, '--rigid' );
 735         }
 736     }
 737
 738     if( scalar( @Torrus::Renderer::graphExtraArgs ) > 0 )
 739     {
 740         push( @args, @Torrus::Renderer::graphExtraArgs );
 741     }
 742
 743     return @args;
 744 }
 745
 746
 747 sub rrd_make_def
 748 {
 749     my $self = shift;
 750     my $config_tree = shift;
 751     my $token = shift;
 752     my $dname = shift;
 753     my $cf = shift;
 754
 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 )
 759     {
 760         my $path = $config_tree->path($token);
 761         Error("$path: No such file or directory: $rrdfile");
 762         return undef;
 763     }
 764
 765     my $ds = $config_tree->getNodeParam($token, 'rrd-ds');
 766     if( not defined $cf )
 767     {
 768         $cf = $config_tree->getNodeParam($token, 'rrd-cf');
 769     }
 770     return sprintf( 'DEF:%s=%s:%s:%s',
 771                     $dname, $rrdfile, $ds, $cf );
 772 }
 773
 774
 775
 776 my %cfNames =
 777     ( 'AVERAGE' => 1,
 778       'MIN'     => 1,
 779       'MAX'     => 1,
 780       'LAST'    => 1 );
 781
 782 # Moved the validation part to Torrus::ConfigTree::Validator
 783 sub rrd_make_cdef
 784 {
 785     my $self  = shift;
 786     my $config_tree = shift;
 787     my $token = shift;
 788     my $dname = shift;
 789     my $expr  = shift;
 790
 791     my @args = ();
 792
 793     # We will name the DEFs as $dname.sprintf('%.2d', $ds_couter++);
 794     my $ds_couter = 1;
 795
 796     my $rpn = new Torrus::RPN;
 797
 798     # The callback for RPN translation
 799     my $callback = sub
 800     {
 801         my ($noderef, $timeoffset) = @_;
 802
 803         my $function;
 804         if( $noderef =~ s/^(.+)\@// )
 805         {
 806             $function = $1;
 807         }
 808
 809         my $cf;
 810         if( defined( $function ) and $cfNames{$function} )
 811         {
 812             $cf = $function;
 813         }
 814
 815         my $leaf = length($noderef) > 0 ?
 816             $config_tree->getRelative($token, $noderef) : $token;
 817
 818         my $varname = $dname . sprintf('%.2d', $ds_couter++);
 819         push( @args,
 820               $self->rrd_make_def( $config_tree, $leaf, $varname, $cf ) );
 821         return $varname;
 822     };
 823
 824     $expr = $rpn->translate( $expr, $callback );
 825     push( @args, sprintf( 'CDEF:%s=%s', $dname, $expr ) );
 826     return @args;
 827 }
 828
 829
 830 sub rrd_if_gprint
 831 {
 832     my $self = shift;
 833     my $config_tree = shift;
 834     my $token = shift;
 835
 836     my $disable = $config_tree->getNodeParam($token, 'graph-disable-gprint');
 837     if( defined( $disable ) and $disable eq 'yes' )
 838     {
 839         return 0;
 840     }
 841     return 1;
 842 }
 843
 844 sub rrd_make_gprint
 845 {
 846     my $self = shift;
 847     my $vname = shift;
 848     my $legend = shift;
 849     my $config_tree = shift;
 850     my $token = shift;
 851     my $view = shift;
 852     my $obj = shift;
 853
 854     my @args = ();
 855
 856     my $gprintValues = $config_tree->getParam($view, 'gprint-values');
 857     if( defined( $gprintValues ) and length( $gprintValues ) > 0 )
 858     {
 859         foreach my $gprintVal ( split(',', $gprintValues ) )
 860         {
 861             my $format =
 862                 $config_tree->getParam($view, 'gprint-format-' . $gprintVal);
 863             push( @args, 'GPRINT:' . $vname . ':' . $format );
 864         }
 865     }
 866
 867     push( @{$obj->{'args'}{'line'}}, @args );
 868 }
 869
 870
 871 sub rrd_make_gprint_header
 872 {
 873     my $self = shift;
 874     my $config_tree = shift;
 875     my $token = shift;
 876     my $view = shift;
 877     my $obj = shift;
 878
 879     my $gprintValues = $config_tree->getParam($view, 'gprint-values');
 880     if( defined( $gprintValues ) and length( $gprintValues ) > 0 )
 881     {
 882         my $gprintHeader = $config_tree->getParam($view, 'gprint-header');
 883         if( defined( $gprintHeader ) and length( $gprintHeader ) > 0 )
 884         {
 885             push( @{$obj->{'args'}{'line'}},
 886                   'COMMENT:' . $gprintHeader . '\l' );
 887         }
 888     }
 889 }
 890
 891
 892 sub mkcolor
 893 {
 894     my $self = shift;
 895     my $color = shift;
 896
 897     my $recursionLimit = 100;
 898
 899     while( $color =~ /^\#\#(\S+)$/ )
 900     {
 901         if( $recursionLimit-- <= 0 )
 902         {
 903             Error('Color recursion is too deep');
 904             $color = '#000000';
 905         }
 906         else
 907         {
 908             my $colorName = $1;
 909             $color = $Torrus::Renderer::graphStyles{$colorName}{'color'};
 910             if( not defined( $color ) )
 911             {
 912                 Error('No color is defined for ' . $colorName);
 913                 $color = '#000000';
 914             }
 915         }
 916     }
 917     return $color;
 918 }
 919
 920 sub mkline
 921 {
 922     my $self = shift;
 923     my $line = shift;
 924
 925     if( $line =~ /^\#\#(\S+)$/ )
 926     {
 927         my $lineName = $1;
 928         $line = $Torrus::Renderer::graphStyles{$lineName}{'line'};
 929         if( not defined( $line ) )
 930         {
 931             Error('No line style is defined for ' . $lineName);
 932             $line = 'LINE1';
 933         }
 934     }
 935     return $line;
 936 }
 937
 938
 939 sub tz_set
 940 {
 941     my $self = shift;
 942
 943     if( defined $ENV{'TZ'} )
 944     {
 945         Debug("Previous TZ value: " . $ENV{'TZ'});
 946         $self->{'tz_defined'} = 1;
 947     }
 948     else
 949     {
 950         $self->{'tz_defined'} = 0;
 951     }
 952
 953     if( defined( my $newTZ = $self->{'options'}->{'variables'}->{'TZ'} ) )
 954     {
 955         Debug("Setting TZ to " . $newTZ);
 956         $self->{'tz_old'} = $ENV{'TZ'};
 957         $ENV{'TZ'} = $newTZ;
 958         $self->{'tz_changed'} = 1;
 959     }
 960     else
 961     {
 962         $self->{'tz_changed'} = 0;
 963     }
 964 }
 965
 966 sub tz_restore
 967 {
 968     my $self = shift;
 969
 970     if( $self->{'tz_changed'} )
 971     {
 972         if( $self->{'tz_defined'} )
 973         {
 974             Debug("Restoring TZ back to " . $self->{'tz_old'});
 975             $ENV{'TZ'} = $self->{'tz_old'};
 976         }
 977         else
 978         {
 979             Debug("Restoring TZ back to undefined");
 980             delete $ENV{'TZ'};
 981         }
 982     }
 983 }
 984
 985
 986 1;
 987
 988
 989 # Local Variables:
 990 # mode: perl
 991 # indent-tabs-mode: nil
 992 # perl-indent-level: 4
 993 # End: