src/lib/Torrus/Renderer/RRDtool.pm

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