summaryrefslogtreecommitdiff
path: root/torrus/perllib/Torrus/Renderer
diff options
context:
space:
mode:
Diffstat (limited to 'torrus/perllib/Torrus/Renderer')
-rw-r--r--torrus/perllib/Torrus/Renderer/AdmInfo.pm242
-rw-r--r--torrus/perllib/Torrus/Renderer/Freeside.pm24
-rw-r--r--torrus/perllib/Torrus/Renderer/Frontpage.pm295
-rw-r--r--torrus/perllib/Torrus/Renderer/HTML.pm597
-rw-r--r--torrus/perllib/Torrus/Renderer/RRDtool.pm993
5 files changed, 2151 insertions, 0 deletions
diff --git a/torrus/perllib/Torrus/Renderer/AdmInfo.pm b/torrus/perllib/Torrus/Renderer/AdmInfo.pm
new file mode 100644
index 000000000..1cbd5106a
--- /dev/null
+++ b/torrus/perllib/Torrus/Renderer/AdmInfo.pm
@@ -0,0 +1,242 @@
+# Copyright (C) 2002 Stanislav Sinyagin
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: AdmInfo.pm,v 1.1 2010-12-27 00:03:44 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+package Torrus::Renderer::AdmInfo;
+
+use strict;
+
+use Torrus::ConfigTree;
+use Torrus::Log;
+use Torrus::ACL;
+
+use Template;
+
+my %rrd_params =
+ (
+ 'leaf-type' => {'rrd-def' => {'rrd-ds' => undef,
+ 'rrd-cf' => undef,
+ 'data-file' => undef,
+ 'data-dir' => undef},
+ 'rrd-cdef' => {'rpn-expr' => undef}},
+ );
+
+my %rrdmulti_params = ( 'ds-names' => undef );
+
+my %collector_params =
+ (
+ 'storage-type' => {'rrd' => {
+ 'data-file' => undef,
+ 'data-dir' => undef,
+ 'leaf-type' => {
+ 'rrd-def' => {'rrd-ds' => undef,
+ 'rrd-cf' => undef,
+ 'rrd-create-dstype' => undef,
+ 'rrd-create-rra' => undef,
+ 'rrd-create-heartbeat' => undef,
+ 'rrd-hwpredict' => {
+ 'enabled' => {'rrd-create-hw-rralen' => undef},
+ 'disabled' => undef
+ }}}}},
+ 'collector-type' => undef,
+ 'collector-period' => undef,
+ 'collector-timeoffset' => undef,
+ 'collector-instance' => undef,
+ 'collector-instance-hashstring' => undef,
+ 'collector-scale' => undef,
+ 'collector-dispersed-timeoffset' => {
+ 'no' => undef,
+ 'yes' => {'collector-timeoffset-min' => undef,
+ 'collector-timeoffset-max' => undef,
+ 'collector-timeoffset-step' => undef,
+ 'collector-timeoffset-hashstring' => undef}}
+ );
+
+
+my %leaf_params =
+ ('ds-type' => {'rrd-file' => \%rrd_params,
+ 'rrd-multigraph' => \%rrdmulti_params,
+ 'collector' => \%collector_params},
+ 'rrgraph-views' => undef,
+ 'rrd-scaling-base' => undef,
+ 'graph-logarithmic' => undef,
+ 'graph-rigid-boundaries' => undef,
+ 'graph-ignore-decorations' => undef,
+ 'nodeid' => undef);
+
+
+my %param_categories =
+ (
+ 'collector-dispersed-timeoffset' => 'Collector',
+ 'collector-period' => 'Collector',
+ 'collector-scale' => 'Collector',
+ 'collector-timeoffset' => 'Collector',
+ 'collector-timeoffset-hashstring' => 'Collector',
+ 'collector-timeoffset-max' => 'Collector',
+ 'collector-timeoffset-min' => 'Collector',
+ 'collector-timeoffset-step' => 'Collector',
+ 'collector-type' => 'Collector',
+ 'collector-instance' => 'Collector',
+ 'collector-instance-hashstring' => 'Collector',
+ 'data-dir' => 'Storage',
+ 'data-file' => 'Storage',
+ 'ds-names' => 'Multigraph',
+ 'ds-type' => 'Common Parameters',
+ 'graph-ignore-decorations' => 'Display',
+ 'graph-logarithmic' => 'Display',
+ 'graph-rigid-boundaries' => 'Display',
+ 'leaf-type' => 'Common Parameters',
+ 'nodeid' => 'Common Parameters',
+ 'rpn-expr' => 'RRD CDEF Paramters',
+ 'rrd-cf' => 'RRD',
+ 'rrd-create-dstype' => 'RRD',
+ 'rrd-create-heartbeat' => 'RRD',
+ 'rrd-create-hw-rralen' => 'RRD',
+ 'rrd-create-rra' => 'RRD',
+ 'rrd-ds' => 'RRD',
+ 'rrd-hwpredict' => 'RRD',
+ 'rrd-scaling-base' => 'RRD',
+ 'rrgraph-views' => 'Display',
+ 'storage-type' => 'Storage'
+ );
+
+
+# Load additional validation, configurable from
+# torrus-config.pl and torrus-siteconfig.pl
+
+foreach my $mod ( @Torrus::Renderer::loadAdmInfo )
+{
+ eval( 'require ' . $mod );
+ die( $@ ) if $@;
+ eval( '&' . $mod . '::initAdmInfo( \%leaf_params, \%param_categories )' );
+ die( $@ ) if $@;
+}
+
+
+# All our methods are imported by Torrus::Renderer;
+
+sub render_adminfo
+{
+ my $self = shift;
+ my $config_tree = shift;
+ my $token = shift;
+ my $view = shift;
+ my $outfile = shift;
+
+ if( $self->may_display_adminfo( $config_tree, $token ) )
+ {
+ $self->{'adminfo'} = $self->retrieve_adminfo( $config_tree, $token );
+ my @ret = $self->render_html( $config_tree, $token, $view, $outfile );
+ delete $self->{'adminfo'};
+ return @ret;
+ }
+ else
+ {
+ if( not open(OUT, ">$outfile") )
+ {
+ Error("Cannot open $outfile for writing: $!");
+ return undef;
+ }
+ else
+ {
+ print OUT "Cannot display admin information\n";
+ close OUT;
+ }
+
+ return (300+time(), 'text/plain');
+ }
+}
+
+
+sub may_display_adminfo
+{
+ my $self = shift;
+ my $config_tree = shift;
+ my $token = shift;
+
+ if( $config_tree->isLeaf( $token ) )
+ {
+ # hasPrivilege is imported from Torrus::Renderer::HTML
+ if( $self->hasPrivilege( $config_tree->treeName(),
+ 'DisplayAdmInfo' ) )
+ {
+ return 1;
+ }
+ }
+
+ return 0;
+}
+
+
+sub retrieve_adminfo
+{
+ my $self = shift;
+ my $config_tree = shift;
+ my $token = shift;
+
+ my $ret = {};
+ my @namemaps = ( \%leaf_params );
+
+ while( scalar( @namemaps ) > 0 )
+ {
+ my @next_namemaps = ();
+
+ foreach my $namemap ( @namemaps )
+ {
+ foreach my $paramkey ( keys %{$namemap} )
+ {
+ my $pname = $paramkey;
+
+ my $pval = $config_tree->getNodeParam( $token, $pname );
+ if( defined( $pval ) )
+ {
+ if( ref( $namemap->{$paramkey} ) )
+ {
+ if( exists $namemap->{$paramkey}->{$pval} )
+ {
+ if( defined $namemap->{$paramkey}->{$pval} )
+ {
+ push( @next_namemaps,
+ $namemap->{$paramkey}->{$pval} );
+ }
+ }
+ }
+
+ my $category = $param_categories{$pname};
+ if( not defined( $category ) )
+ {
+ $category = 'Other';
+ }
+ $ret->{$category}{$pname} = $pval;
+ }
+ }
+ }
+ @namemaps = @next_namemaps;
+ }
+
+ return $ret;
+}
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/Renderer/Freeside.pm b/torrus/perllib/Torrus/Renderer/Freeside.pm
new file mode 100644
index 000000000..9a7c023be
--- /dev/null
+++ b/torrus/perllib/Torrus/Renderer/Freeside.pm
@@ -0,0 +1,24 @@
+package Torrus::Renderer::Freeside;
+
+use strict;
+use warnings;
+use base 'Torrus::Freeside';
+use FS::UID qw(cgisuidsetup);
+use FS::TicketSystem;
+
+our $cgi = '';
+
+sub freesideSetup {
+ #my $self = shift;
+
+ return if $cgi eq $Torrus::CGI::q;
+
+ $cgi = $Torrus::CGI::q;
+
+ cgisuidsetup($cgi);
+ FS::TicketSystem->init();
+
+}
+
+1;
+
diff --git a/torrus/perllib/Torrus/Renderer/Frontpage.pm b/torrus/perllib/Torrus/Renderer/Frontpage.pm
new file mode 100644
index 000000000..715a01926
--- /dev/null
+++ b/torrus/perllib/Torrus/Renderer/Frontpage.pm
@@ -0,0 +1,295 @@
+# Copyright (C) 2002 Stanislav Sinyagin
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: Frontpage.pm,v 1.2 2010-12-27 08:40:19 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+package Torrus::Renderer::Frontpage;
+
+use strict;
+
+use Torrus::ConfigTree;
+use Torrus::Search;
+use Torrus::Log;
+
+use Template;
+use URI::Escape;
+
+# All our methods are imported by Torrus::Renderer;
+
+sub renderUserLogin
+{
+ my $self = shift;
+ my %new_options = @_;
+
+ if( %new_options )
+ {
+ $self->{'options'} = \%new_options;
+ }
+
+ my($t_render, $t_expires, $filename, $mime_type);
+
+ my $cachekey = $self->cacheKey( 'LOGINSCREEN' );
+
+ ($t_render, $t_expires, $filename, $mime_type) =
+ $self->getCache( $cachekey );
+
+ # We don't check the expiration time for login screen
+ if( not defined( $filename ) )
+ {
+ $filename = Torrus::Renderer::newCacheFileName( $cachekey );
+ }
+
+ my $outfile = $Torrus::Global::cacheDir.'/'.$filename;
+
+ $t_expires = time();
+ $mime_type = $Torrus::Renderer::LoginScreen::mimeType;
+ my $tmplfile = $Torrus::Renderer::LoginScreen::template;
+
+ # Create the Template Toolkit processor once, and reuse
+ # it in subsequent render() calls
+
+ if( not defined( $self->{'tt'} ) )
+ {
+ $self->{'tt'} =
+ new Template(INCLUDE_PATH => $Torrus::Global::templateDirs,
+ TRIM => 1);
+ }
+
+ my $url = $Torrus::Renderer::rendererURL;
+ if( length( $self->{'options'}->{'urlPassTree'} ) > 0 )
+ {
+ $url .= '/' . $self->{'options'}->{'urlPassTree'};
+ }
+
+ my $ttvars =
+ {
+ 'url' => $url,
+ 'plainURL' => $Torrus::Renderer::plainURL,
+ 'style' => sub { return $self->style($_[0]); },
+ 'companyName'=> $Torrus::Renderer::companyName,
+ 'companyLogo'=> $Torrus::Renderer::companyLogo,
+ 'companyURL' => $Torrus::Renderer::companyURL,
+ 'lostPasswordURL' => $Torrus::Renderer::lostPasswordURL,
+ 'siteInfo' => $Torrus::Renderer::siteInfo,
+ 'version' => $Torrus::Global::version,
+ 'xmlnorm' => \&Torrus::Renderer::xmlnormalize
+ };
+
+
+ # Pass the options from Torrus::Renderer::render() to Template
+ while( my( $opt, $val ) = each( %{$self->{'options'}} ) )
+ {
+ $ttvars->{$opt} = $val;
+ }
+
+ my $result = $self->{'tt'}->process( $tmplfile, $ttvars, $outfile );
+
+ undef $ttvars;
+
+ my @ret;
+ if( not $result )
+ {
+ Error("Error while rendering login screen: " .
+ $self->{'tt'}->error());
+ }
+ else
+ {
+ $self->setCache($cachekey, time(), $t_expires, $filename, $mime_type);
+ @ret = ($outfile, $mime_type, $t_expires - time());
+ }
+
+ $self->{'options'} = undef;
+
+ return @ret;
+}
+
+
+sub renderTreeChooser
+{
+ my $self = shift;
+ my %new_options = @_;
+
+ if( %new_options )
+ {
+ $self->{'options'} = \%new_options;
+ }
+
+ my($t_render, $t_expires, $filename, $mime_type);
+
+ my $uid = '';
+ if( $self->{'options'}->{'uid'} )
+ {
+ $uid = $self->{'options'}->{'uid'};
+ }
+
+ my $cachekey = $self->cacheKey( $uid . ':' . 'TREECHOOSER' );
+
+ ($t_render, $t_expires, $filename, $mime_type) =
+ $self->getCache( $cachekey );
+
+ if( defined( $filename ) )
+ {
+ if( $t_expires >= time() )
+ {
+ return ($Torrus::Global::cacheDir.'/'.$filename,
+ $mime_type, $t_expires - time());
+ }
+ # Else reuse the old filename
+ }
+ else
+ {
+ $filename = Torrus::Renderer::newCacheFileName( $cachekey );
+ }
+
+ my $outfile = $Torrus::Global::cacheDir.'/'.$filename;
+
+ $t_expires = time() + $Torrus::Renderer::Chooser::expires;
+ $mime_type = $Torrus::Renderer::Chooser::mimeType;
+
+ my $tmplfile;
+ if( defined( $self->{'options'}{'variables'}{'SEARCH'} ) and
+ $self->mayGlobalSearch() )
+ {
+ $tmplfile = $Torrus::Renderer::Chooser::searchTemplate;
+ }
+ else
+ {
+ $tmplfile = $Torrus::Renderer::Chooser::template;
+ }
+
+ # Create the Template Toolkit processor once, and reuse
+ # it in subsequent render() calls
+
+ if( not defined( $self->{'tt'} ) )
+ {
+ $self->{'tt'} =
+ new Template(INCLUDE_PATH => $Torrus::Global::templateDirs,
+ TRIM => 1);
+ }
+
+ my $ttvars =
+ {
+ 'treeNames' => sub{ return Torrus::SiteConfig::listTreeNames() },
+ 'treeDescr' => sub{ return
+ Torrus::SiteConfig::treeDescription($_[0]) }
+ ,
+ 'url' => sub { return $Torrus::Renderer::rendererURL . '/' . $_[0] },
+ 'plainURL' => $Torrus::Renderer::plainURL,
+ 'persistentUrl' => sub { return $Torrus::Renderer::rendererURL . '/' .
+ $_[0] . '?path=' . uri_escape($_[1])}
+ ,
+ 'clearVar' => sub { delete $self->{'options'}{'variables'}{$_[0]};
+ return undef;},
+ 'style' => sub { return $self->style($_[0]); },
+ 'companyName'=> $Torrus::Renderer::companyName,
+ 'companyLogo'=> $Torrus::Renderer::companyLogo,
+ 'companyURL' => $Torrus::Renderer::companyURL,
+ 'siteInfo' => $Torrus::Renderer::siteInfo,
+ 'version' => $Torrus::Global::version,
+ 'xmlnorm' => \&Torrus::Renderer::xmlnormalize,
+ 'userAuth' => $Torrus::CGI::authorizeUsers,
+ 'uid' => $self->{'options'}->{'uid'},
+ 'userAttr' => sub { return $self->userAttribute( $_[0] ) },
+ 'mayDisplayTree' => sub { return $self->
+ hasPrivilege( $_[0], 'DisplayTree' ) }
+ ,
+ 'mayGlobalSearch' => sub { return $self->mayGlobalSearch(); },
+ 'searchResults' => sub { return $self->doGlobalSearch($_[0]); },
+
+ #Freeside
+ 'freesideHeader' => sub { return $self->freesideHeader(@_); },
+ 'freesideFooter' => sub { return $self->freesideFooter(); },
+ };
+
+
+ # Pass the options from Torrus::Renderer::render() to Template
+ while( my( $opt, $val ) = each( %{$self->{'options'}} ) )
+ {
+ $ttvars->{$opt} = $val;
+ }
+
+ my $result = $self->{'tt'}->process( $tmplfile, $ttvars, $outfile );
+
+ undef $ttvars;
+
+ my @ret;
+ if( not $result )
+ {
+ Error("Error while rendering tree chooser: " .
+ $self->{'tt'}->error());
+ }
+ else
+ {
+ $self->setCache($cachekey, time(), $t_expires, $filename, $mime_type);
+ @ret = ($outfile, $mime_type, $t_expires - time());
+ }
+
+ $self->{'options'} = undef;
+
+ return @ret;
+}
+
+
+sub mayGlobalSearch
+{
+ my $self = shift;
+
+ return ( $Torrus::Renderer::globalSearchEnabled and
+ ( not $Torrus::CGI::authorizeUsers or
+ ( $self->hasPrivilege( '*', 'GlobalSearch' ) ) ) );
+}
+
+sub doGlobalSearch
+{
+ my $self = shift;
+ my $string = shift;
+
+ my $sr = new Torrus::Search;
+ $sr->openGlobal();
+ my $result = $sr->searchPrefix( $string );
+
+ my $sorted = [];
+ push( @{$sorted}, sort {$a->[0] cmp $b->[0]} @{$result} );
+
+ # remove duplicating entries
+ my %seen;
+ my $ret = [];
+
+ foreach my $element ( @{$sorted} )
+ {
+ my $string = join( ':', $element->[0], $element->[1] );
+ if( not $seen{$string} )
+ {
+ $seen{$string} = 1;
+ push( @{$ret}, $element );
+ }
+ }
+
+ return $ret;
+}
+
+
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/Renderer/HTML.pm b/torrus/perllib/Torrus/Renderer/HTML.pm
new file mode 100644
index 000000000..6eec86d21
--- /dev/null
+++ b/torrus/perllib/Torrus/Renderer/HTML.pm
@@ -0,0 +1,597 @@
+# Copyright (C) 2002 Stanislav Sinyagin
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: HTML.pm,v 1.14 2011-03-01 00:09:39 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+package Torrus::Renderer::HTML;
+
+use strict;
+
+use Torrus::ConfigTree;
+use Torrus::Search;
+use Torrus::Log;
+
+use URI::Escape;
+use Template;
+use POSIX qw(abs log floor pow);
+use Date::Parse;
+use Date::Format;
+
+Torrus::SiteConfig::loadStyling();
+
+# All our methods are imported by Torrus::Renderer;
+
+sub render_html
+{
+ my $self = shift;
+ my $config_tree = shift;
+ my $token = shift;
+ my $view = shift;
+ my $outfile = shift;
+
+ my $tmplfile = $config_tree->getParam($view, 'html-template');
+
+ my $expires = $config_tree->getParam($view, 'expires');
+
+ # Create the Template Toolkit processor once, and reuse
+ # it in subsequent render() calls
+
+ if( not defined( $self->{'tt'} ) )
+ {
+ $self->{'tt'} =
+ new Template(INCLUDE_PATH => $Torrus::Global::templateDirs,
+ TRIM => 1);
+ }
+ my $ttvars =
+ {
+ 'treeName' => $config_tree->treeName(),
+ 'token' => $token,
+ 'view' => $view,
+ 'expires' => $expires,
+ 'path' => sub { return $config_tree->path($_[0]); },
+ 'pathToken' => sub { return $config_tree->token($_[0]); },
+ 'nodeExists' => sub { return $config_tree->nodeExists($_[0]); },
+ 'children' => sub { return $config_tree->getChildren($_[0]); },
+ 'isLeaf' => sub { return $config_tree->isLeaf($_[0]); },
+ 'isAlias' => sub { return $config_tree->isAlias($_[0]); },
+ 'sortTokens' => sub { return $self->sortTokens($config_tree,
+ $_[0]); },
+ 'nodeName' => sub { return $self->nodeName($config_tree, $_[0]); },
+ 'parent' => sub { return $config_tree->getParent($_[0]); },
+ 'nodeParam' => sub { return $config_tree->getNodeParam(@_); },
+ 'param' => sub { return $config_tree->getParam(@_); },
+ 'url' => sub { return $self->makeURL($config_tree, 0, @_); },
+ 'persistentUrl' => sub { return $self->makeURL($config_tree, 1, @_); },
+ 'clearVar' => sub { delete $self->{'options'}{'variables'}{$_[0]};
+ return undef;},
+ 'plainURL' => $Torrus::Renderer::plainURL,
+ 'splitUrls' => sub { return $self->makeSplitURLs($config_tree,
+ $_[0], $_[1]); },
+ 'topURL' => ($Torrus::Renderer::rendererURL ne '' ?
+ $Torrus::Renderer::rendererURL : '/'),
+ 'rrprint' => sub { return $self->rrPrint($config_tree,
+ $_[0], $_[1]); },
+ 'scale' => sub { return $self->scale($_[0], $_[1]); },
+ 'tsetMembers' => sub { $config_tree->tsetMembers($_[0]); },
+ 'tsetList' => sub { $config_tree->getTsets(); },
+ 'style' => sub { return $self->style($_[0]); },
+ 'companyName'=> $Torrus::Renderer::companyName,
+ 'companyLogo'=> $Torrus::Renderer::companyLogo,
+ 'companyURL' => $Torrus::Renderer::companyURL,
+ 'siteInfo' => $Torrus::Renderer::siteInfo,
+ 'treeInfo' => sub { return $Torrus::Global::treeConfig{
+ $config_tree->treeName()}{'info'}; },
+ 'version' => $Torrus::Global::version,
+ 'xmlnorm' => \&Torrus::Renderer::xmlnormalize,
+ 'userAuth' => $Torrus::CGI::authorizeUsers,
+ 'uid' => $self->{'options'}->{'uid'},
+ 'userAttr' => sub { return $self->userAttribute( $_[0] ) },
+ 'mayDisplayAdmInfo' => sub {
+ return $self->may_display_adminfo( $config_tree, $_[0] ) },
+ 'adminfo' => $self->{'adminfo'},
+ 'mayDisplayReports' => sub {
+ return $self->may_display_reports($config_tree) },
+ 'reportsUrl' => sub {
+ return $self->reportsUrl($config_tree); },
+ 'timestamp' => sub { return time2str($Torrus::Renderer::timeFormat,
+ time()); },
+ 'verifyDate' => sub { return verifyDate($_[0]); },
+ 'markup' => sub{ return $self->translateMarkup( @_ ); },
+ 'searchEnabled' => $Torrus::Renderer::searchEnabled,
+ 'searchResults' => sub { return $self->doSearch($config_tree, $_[0]); },
+
+ #Freeside
+ 'freesideHeader' => sub { return $self->freesideHeader(@_); },
+ 'freesideFooter' => sub { return $self->freesideFooter(); },
+ 'freesideComponent' => sub { return $self->freesideComponent(@_); },
+ 'uri_escape' => sub { return uri_escape(@_); },
+ 'matches' => sub { return $_[0] =~ $_[1]; },
+ 'iface_underscore' => sub { $_[0] =~ s/[\/\.]/_/g; return $_[0]; },
+ 'load_nms' => sub { return $self->load_nms; },
+ 'get_serviceids' => sub { my $nms = shift;
+ my $router = shift;
+ return $nms->get_router_serviceids($router);
+ },
+ 'popup_link' => sub {
+ my $type = shift;
+
+ if($type eq 'nms-add_iface.html') {
+ my $host = shift;
+ my $iface = shift;
+ my $nms = shift;
+ my $serviceids = shift;
+
+ if ( $serviceids && $serviceids->{$iface} ) {
+
+ my $svc_port = $nms->find_svc($serviceids->{$iface});
+
+ if ($svc_port) {
+ my $url = $Torrus::Freeside::FSURL.
+ "/view/svc_port.cgi?". $svc_port->svcnum;
+ return "<A HREF='$url'>View Service</A>";
+ } else {
+ my $component =
+ $nms->find_torrus_srvderive_component($serviceids->{$iface});
+
+ if ($component) {
+ return $serviceids->{$iface}. ' combined into '.
+ $component->torrus_srvderive->serviceid;
+ } else {
+ return 'Monitored as '. $serviceids->{$iface}.
+ '; not yet provisioned or combined';
+ }
+ }
+
+ } else {
+
+ return
+ $self->freesideComponent('/elements/popup_link.html',
+ 'action' => "/freeside/misc/".
+ $type."?host=$host;iface=$iface",
+ 'label' => 'Monitor for billing',
+ 'actionlabel' => 'Monitor interface',
+ );
+
+ }
+
+ } elsif ($type eq 'nms-add_router.html') {
+ return
+ $self->freesideComponent('/elements/popup_link.html',
+ 'action' => "/freeside/misc/$type",
+ 'label' => 'Add Router',
+ 'actionlabel' => 'Add Router',
+ );
+ }
+
+ '';
+ },
+
+ };
+
+
+ # Pass the options from Torrus::Renderer::render() to Template
+ while( my( $opt, $val ) = each( %{$self->{'options'}} ) )
+ {
+ $ttvars->{$opt} = $val;
+ }
+
+ my $result = $self->{'tt'}->process( $tmplfile, $ttvars, $outfile );
+
+ undef $ttvars;
+
+ if( not $result )
+ {
+ if( $config_tree->isTset( $token ) )
+ {
+ Error("Error while rendering tokenset $token: " .
+ $self->{'tt'}->error());
+ }
+ else
+ {
+ my $path = $config_tree->path($token);
+ Error("Error while rendering $path: " .
+ $self->{'tt'}->error());
+ }
+ return undef;
+ }
+
+ return ($expires+time(), 'text/html; charset=UTF-8');
+}
+
+
+sub nodeName
+{
+ my $self = shift;
+ my $config_tree = shift;
+ my $token = shift;
+
+ my $n = $config_tree->getNodeParam($token, 'node-display-name', 1);
+ if( defined( $n ) and length( $n ) > 0 )
+ {
+ return $n;
+ }
+
+ return $config_tree->nodeName($config_tree->path($token));
+}
+
+
+sub sortTokens
+{
+ my $self = shift;
+ my $config_tree = shift;
+ my $tokenlist = shift;
+
+ my @sorted = ();
+ if( ref($tokenlist) and scalar(@{$tokenlist}) > 0 )
+ {
+ @sorted = sort
+ {
+ my $p_a = $config_tree->getNodeParam($a, 'precedence', 1);
+ $p_a = 0 unless defined $p_a;
+ my $p_b = $config_tree->getNodeParam($b, 'precedence', 1);
+ $p_b = 0 unless defined $p_b;
+ if( $p_a == $p_b )
+ {
+ my $n_a = $config_tree->path($a);
+ my $n_b = $config_tree->path($b);
+ return $n_a cmp $n_b;
+ }
+ else
+ {
+ return $p_b <=> $p_a;
+ }
+ } @{$tokenlist};
+ }
+ else
+ {
+ push(@sorted, $tokenlist);
+ }
+ return @sorted;
+}
+
+
+# compose an URL for a node.
+# $persistent defines if the link should be persistent
+# Persistent link is done with nodeid if available, or with path
+
+sub makeURL
+{
+ my $self = shift;
+ my $config_tree = shift;
+ my $persistent = shift;
+ my $token = shift;
+ my $view = shift;
+ my @add_vars = @_;
+
+ my $ret = $Torrus::Renderer::rendererURL . '/' . $config_tree->treeName();
+
+ if( $persistent )
+ {
+ my $nodeid = $config_tree->getNodeParam($token, 'nodeid', 1);
+ if( defined( $nodeid ) )
+ {
+ $ret .= '?nodeid=' .
+ uri_escape($nodeid, $Torrus::Renderer::uriEscapeExceptions);
+ }
+ else
+ {
+ $ret .= '?path=' .
+ uri_escape($config_tree->path($token),
+ $Torrus::Renderer::uriEscapeExceptions);
+ }
+ }
+ else
+ {
+ $ret .= '?token=' . uri_escape($token);
+ }
+
+ if( $view )
+ {
+ $ret .= '&amp;view=' . uri_escape($view);
+ }
+
+ my %vars = ();
+ # This could be array or a reference to array
+ my $add_vars_size = scalar( @add_vars );
+ if( $add_vars_size == 1 and ref( $add_vars[0] ) )
+ {
+ %vars = @{$add_vars[0]};
+ }
+ elsif( $add_vars_size > 0 and ($add_vars_size % 2 == 0) )
+ {
+ %vars = @add_vars;
+ }
+
+ if( ref( $self->{'options'}->{'variables'} ) )
+ {
+ foreach my $name ( sort keys %{$self->{'options'}->{'variables'}} )
+ {
+ my $val = $self->{'options'}->{'variables'}->{$name};
+ if( not defined( $vars{$name} ) )
+ {
+ $vars{$name} = $val;
+ }
+ }
+ }
+
+ foreach my $name ( sort keys %vars )
+ {
+ if( $vars{$name} ne '' )
+ {
+ $ret .= '&amp;' . $name . '=' .
+ uri_escape( $vars{$name},
+ $Torrus::Renderer::uriEscapeExceptions );
+ }
+ }
+
+ return $ret;
+}
+
+sub makeSplitURLs
+{
+ my $self = shift;
+ my $config_tree = shift;
+ my $token = shift;
+ my $view = shift;
+
+ my $ret = '';
+ while( defined( $token ) )
+ {
+ my $path = $config_tree->path($token);
+
+ my $str = '<SPAN CLASS="PathElement">';
+ $str .=
+ sprintf('<A HREF="%s">%s%s</A>',
+ $self->makeURL($config_tree, 0, $token, $view),
+ $config_tree->nodeName($path),
+ ( $config_tree->isSubtree($token) and
+ $path ne '/') ? '/':'' );
+ $str .= "</SPAN>\n";
+
+ $ret = $str . $ret;
+
+ $token = $config_tree->getParent( $token );
+ }
+
+ return $ret;
+}
+
+
+sub rrPrint
+{
+ my $self = shift;
+ my $config_tree = shift;
+ my $token = shift;
+ my $view = shift;
+
+ my @ret = ();
+ my($fname, $mimetype) = $self->render( $config_tree, $token, $view );
+
+ if( $mimetype ne 'text/plain' )
+ {
+ Error("View $view does not produce text/plain for token $token");
+ }
+ else
+ {
+ if( not open(IN, $fname) )
+ {
+ Error("Cannot open $fname for reading: $!");
+ }
+ else
+ {
+ chomp(my $values = <IN>);
+ @ret = split(':', $values);
+ close IN;
+ }
+ }
+ return @ret;
+}
+
+# This subroutine is taken from Dave Plonka's Flowscan
+
+sub scale
+{
+ my $self = shift;
+ # This is based somewhat on Tobi Oetiker's code in rrd_graph.c:
+ my $fmt = shift;
+ my $value = shift;
+ my @symbols = ("a", # 10e-18 Ato
+ "f", # 10e-15 Femto
+ "p", # 10e-12 Pico
+ "n", # 10e-9 Nano
+ "u", # 10e-6 Micro
+ "m", # 10e-3 Milli
+ " ", # Base
+ "k", # 10e3 Kilo
+ "M", # 10e6 Mega
+ "G", # 10e9 Giga
+ "T", # 10e12 Terra
+ "P", # 10e15 Peta
+ "E"); # 10e18 Exa
+
+ my $symbcenter = 6;
+ my $digits = (0 == $value)? 0 : floor(log(abs($value))/log(1000));
+ return sprintf( $fmt . " %s", $value/pow(1000, $digits),
+ $symbols[ $symbcenter+$digits ] );
+}
+
+sub style
+{
+ my $self = shift;
+ my $object = shift;
+
+ my $media;
+ if( not defined( $media = $self->{'options'}->{'variables'}->{'MEDIA'} ) )
+ {
+ $media = 'default';
+ }
+ return $Torrus::Renderer::styling{$media}{$object};
+}
+
+
+
+sub userAttribute
+{
+ my $self = shift;
+ my $attr = shift;
+
+ if( $self->{'options'}->{'uid'} and $self->{'options'}->{'acl'} )
+ {
+ $self->{'options'}->{'acl'}->
+ userAttribute( $self->{'options'}->{'uid'}, $attr );
+ }
+ else
+ {
+ return '';
+ }
+}
+
+sub hasPrivilege
+{
+ my $self = shift;
+ my $object = shift;
+ my $privilege = shift;
+
+ if( $self->{'options'}->{'uid'} and $self->{'options'}->{'acl'} )
+ {
+ $self->{'options'}->{'acl'}->
+ hasPrivilege( $self->{'options'}->{'uid'}, $object, $privilege );
+ }
+ else
+ {
+ return undef;
+ }
+}
+
+
+sub translateMarkup
+{
+ my $self = shift;
+ my @strings = @_;
+
+ my $tt = new Template( TRIM => 1 );
+
+ my $ttvars =
+ {
+ 'em' => sub { return '<em>' . $_[0] . '</em>'; },
+ 'strong' => sub { return '<strong>' . $_[0] . '</strong>'; }
+ };
+
+ my $ret = '';
+
+ foreach my $str ( @strings )
+ {
+ my $output = '';
+ my $result = $tt->process( \$str, $ttvars, \$output );
+
+ if( not $result )
+ {
+ Error('Error translating markup: ' . $tt->error());
+ }
+ else
+ {
+ $ret .= $output;
+ }
+ }
+
+ undef $tt;
+
+ return $ret;
+}
+
+
+sub verifyDate
+{
+ my $input = shift;
+
+ my $time = str2time( $input );
+ # rrdtool does not understand dates prior to 1980 (315529200)
+ if( defined( $time ) and $time > 315529200 )
+ {
+ # Present the time in format understood by rrdtool
+ return time2str('%H:%M %Y%m%d', $time);
+ }
+ else
+ {
+ return '';
+ }
+}
+
+
+sub may_display_reports
+{
+ my $self = shift;
+ my $config_tree = shift;
+
+ if( $Torrus::Renderer::displayReports )
+ {
+ if( not $Torrus::CGI::authorizeUsers )
+ {
+ return 1;
+ }
+
+ my $tree = $config_tree->treeName();
+ if( $self->hasPrivilege( $tree, 'DisplayReports' ) and
+ -r $Torrus::Global::reportsDir . '/' . $tree .
+ '/html/index.html' )
+ {
+ return 1;
+ }
+ }
+ return 0;
+}
+
+
+sub reportsUrl
+{
+ my $self = shift;
+ my $config_tree = shift;
+
+ return $Torrus::Renderer::rendererURL . '/' .
+ $config_tree->treeName() . '?htmlreport=index.html';
+}
+
+
+sub doSearch
+{
+ my $self = shift;
+ my $config_tree = shift;
+ my $string = shift;
+
+
+ my $tree = $config_tree->treeName();
+
+ my $sr = new Torrus::Search;
+ $sr->openTree( $tree );
+ my $result = $sr->searchPrefix( $string, $tree );
+ $sr->closeTree( $tree );
+
+ my $ret = [];
+ push( @{$ret}, sort {$a->[0] cmp $b->[0]} @{$result} );
+
+ return $ret;
+}
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/Renderer/RRDtool.pm b/torrus/perllib/Torrus/Renderer/RRDtool.pm
new file mode 100644
index 000000000..db0cc54a9
--- /dev/null
+++ b/torrus/perllib/Torrus/Renderer/RRDtool.pm
@@ -0,0 +1,993 @@
+# Copyright (C) 2002 Stanislav Sinyagin
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: RRDtool.pm,v 1.1 2010-12-27 00:03:44 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+package Torrus::Renderer::RRDtool;
+
+use strict;
+
+use Torrus::ConfigTree;
+use Torrus::RPN;
+use Torrus::Log;
+
+use RRDs;
+
+# All our methods are imported by Torrus::Renderer;
+
+my %rrd_graph_opts =
+ (
+ 'start' => '--start',
+ 'end' => '--end',
+ 'width' => '--width',
+ 'height' => '--height'
+ );
+
+my @arg_arrays = qw(opts defs bg hwtick hrule hwline line fg);
+
+
+sub render_rrgraph
+{
+ my $self = shift;
+ my $config_tree = shift;
+ my $token = shift;
+ my $view = shift;
+ my $outfile = shift;
+
+ if( not $config_tree->isLeaf($token) )
+ {
+ Error("Token $token is not a leaf");
+ return undef;
+ }
+
+ my $obj = {'args' => {}, 'dname' => 'A'};
+
+ foreach my $arrayName ( @arg_arrays )
+ {
+ $obj->{'args'}{$arrayName} = [];
+ }
+
+ push( @{$obj->{'args'}{'opts'}},
+ $self->rrd_make_opts( $config_tree, $token, $view,
+ \%rrd_graph_opts, ) );
+
+ push( @{$obj->{'args'}{'opts'}},
+ $self->rrd_make_graph_opts( $config_tree, $token, $view ) );
+
+ my $dstype = $config_tree->getNodeParam($token, 'ds-type');
+
+ if( $dstype eq 'rrd-multigraph' )
+ {
+ $self->rrd_make_multigraph( $config_tree, $token, $view, $obj );
+ }
+ else
+ {
+ my $leaftype = $config_tree->getNodeParam($token, 'leaf-type');
+
+ # Handle DEFs and CDEFs
+ # At the moment, we call the DEF as 'A'. Could change in the future
+ if( $leaftype eq 'rrd-def' )
+ {
+ push( @{$obj->{'args'}{'defs'}},
+ $self->rrd_make_def( $config_tree, $token,
+ $obj->{'dname'} ) );
+
+ if( $self->rrd_check_hw( $config_tree, $token, $view ) )
+ {
+ $self->rrd_make_holtwinters( $config_tree, $token,
+ $view, $obj );
+ }
+ }
+ elsif( $leaftype eq 'rrd-cdef' )
+ {
+ my $expr = $config_tree->getNodeParam($token, 'rpn-expr');
+ push( @{$obj->{'args'}{'defs'}},
+ $self->rrd_make_cdef($config_tree, $token,
+ $obj->{'dname'}, $expr) );
+ }
+ else
+ {
+ Error("Unsupported leaf-type: $leaftype");
+ return undef;
+ }
+
+ $self->rrd_make_graphline( $config_tree, $token, $view, $obj );
+ }
+
+ $self->rrd_make_hrules( $config_tree, $token, $view, $obj );
+ if( not $Torrus::Renderer::ignoreDecorations )
+ {
+ $self->rrd_make_decorations( $config_tree, $token, $view, $obj );
+ }
+
+ # We're all set
+
+
+ my @args;
+ foreach my $arrayName ( @arg_arrays )
+ {
+ push( @args, @{$obj->{'args'}{$arrayName}} );
+ }
+ Debug("RRDs::graph arguments: " . join(' ', @args));
+
+ $self->tz_set();
+ &RRDs::graph( $outfile, @args );
+ $self->tz_restore();
+ my $ERR=RRDs::error;
+ if( $ERR )
+ {
+ my $path = $config_tree->path($token);
+ Error("$path $view: Error during RRD graph: $ERR");
+ return undef;
+ }
+
+ return( $config_tree->getParam($view, 'expires')+time(), 'image/png' );
+}
+
+
+my %rrd_print_opts =
+ (
+ 'start' => '--start',
+ 'end' => '--end',
+ );
+
+
+
+sub render_rrprint
+{
+ my $self = shift;
+ my $config_tree = shift;
+ my $token = shift;
+ my $view = shift;
+ my $outfile = shift;
+
+ if( not $config_tree->isLeaf($token) )
+ {
+ Error("Token $token is not a leaf");
+ return undef;
+ }
+
+ my @arg_opts;
+ my @arg_defs;
+ my @arg_print;
+
+ push( @arg_opts, $self->rrd_make_opts( $config_tree, $token, $view,
+ \%rrd_print_opts, ) );
+
+ my $dstype = $config_tree->getNodeParam($token, 'ds-type');
+
+ if( $dstype eq 'rrd-multigraph' )
+ {
+ Error("View type rrprint is not supported ".
+ "for DS type rrd-multigraph");
+ return undef;
+ }
+
+ my $leaftype = $config_tree->getNodeParam($token, 'leaf-type');
+
+ # Handle DEFs and CDEFs
+ # At the moment, we call the DEF as 'A'. Could change in the future
+ my $dname = 'A';
+ if( $leaftype eq 'rrd-def' )
+ {
+ push( @arg_defs,
+ $self->rrd_make_def( $config_tree, $token, $dname ) );
+ }
+ elsif( $leaftype eq 'rrd-cdef' )
+ {
+ my $expr = $config_tree->getNodeParam($token, 'rpn-expr');
+ push( @arg_defs,
+ $self->rrd_make_cdef($config_tree, $token, $dname, $expr) );
+ }
+ else
+ {
+ Error("Unsupported leaf-type: $leaftype");
+ return undef;
+ }
+
+ foreach my $cf ( split(',', $config_tree->getParam($view, 'print-cf')) )
+ {
+ push( @arg_print, sprintf( 'PRINT:%s:%s:%%le', $dname, $cf ) );
+ }
+
+ # We're all set
+
+ my @args = ( @arg_opts, @arg_defs, @arg_print );
+ Debug("RRDs::graph arguments: " . join(' ', @args));
+
+ my $printout;
+ $self->tz_set();
+ ($printout, undef, undef) = RRDs::graph('/dev/null', @args);
+ $self->tz_restore();
+ my $ERR=RRDs::error;
+ if( $ERR )
+ {
+ my $path = $config_tree->path($token);
+ Error("$path $view: Error during RRD graph: $ERR");
+ return undef;
+ }
+
+ if( not open(OUT, ">$outfile") )
+ {
+ Error("Cannot open $outfile for writing: $!");
+ return undef;
+ }
+ else
+ {
+ printf OUT ("%s\n", join(':', @{$printout}));
+ close OUT;
+ }
+
+ return( $config_tree->getParam($view, 'expires')+time(), 'text/plain' );
+}
+
+
+
+sub rrd_make_multigraph
+{
+ my $self = shift;
+ my $config_tree = shift;
+ my $token = shift;
+ my $view = shift;
+ my $obj = shift;
+
+ my @dsNames =
+ split(',', $config_tree->getNodeParam($token, 'ds-names') );
+
+ # We need this to refer to some existing variable name
+ $obj->{'dname'} = $dsNames[0];
+
+ # Analyze the drawing order
+ my %dsOrder;
+ foreach my $dname ( @dsNames )
+ {
+ my $order = $config_tree->getNodeParam($token, 'line-order-'.$dname);
+ $dsOrder{$dname} = defined( $order ) ? $order : 100;
+ }
+
+ my $disable_legend = $config_tree->getParam($view, 'disable-legend');
+ $disable_legend =
+ (defined($disable_legend) and $disable_legend eq 'yes') ? 1:0;
+
+ # make DEFs and Line instructions
+
+ my $do_gprint = 0;
+
+ if( not $disable_legend )
+ {
+ $do_gprint = $self->rrd_if_gprint( $config_tree, $token );
+ if( $do_gprint )
+ {
+ $self->rrd_make_gprint_header( $config_tree, $token, $view, $obj );
+ }
+ }
+
+ foreach my $dname ( sort {$dsOrder{$a} <=> $dsOrder{$b}} @dsNames )
+ {
+ my $dograph = 1;
+ my $ignoreViews =
+ $config_tree->getNodeParam($token, 'ignore-views-'.$dname);
+ if( defined( $ignoreViews ) and
+ grep {$_ eq $view} split(',', $ignoreViews) )
+ {
+ $dograph = 0;
+ }
+
+ my $gprint_this = $do_gprint;
+ if( $do_gprint )
+ {
+ my $ds_nogprint =
+ $config_tree->getNodeParam($token, 'disable-gprint-'.$dname);
+ if( defined( $ds_nogprint ) and $ds_nogprint eq 'yes' )
+ {
+ $gprint_this = 0;
+ }
+ }
+
+ my $legend;
+
+ if( $dograph or $gprint_this )
+ {
+ my $expr = $config_tree->getNodeParam($token, 'ds-expr-'.$dname);
+ push( @{$obj->{'args'}{'defs'}},
+ $self->rrd_make_cdef($config_tree, $token, $dname, $expr) );
+
+ $legend =
+ $config_tree->getNodeParam($token, 'graph-legend-'.$dname);
+ if( defined( $legend ) )
+ {
+ $legend =~ s/:/\\:/g;
+ }
+ else
+ {
+ $legend = '';
+ }
+ }
+
+ if( $gprint_this )
+ {
+ $self->rrd_make_gprint( $dname, $legend,
+ $config_tree, $token, $view, $obj );
+ if( not $dograph )
+ {
+ push( @{$obj->{'args'}{'line'}},
+ 'COMMENT:' . $legend . '\l');
+ }
+ }
+ else
+ {
+ # For datasource that disables gprint, there's no reason
+ # to print the label
+ $legend = '';
+ }
+
+ if( $dograph )
+ {
+ my $linestyle =
+ $self->mkline( $config_tree->getNodeParam
+ ($token, 'line-style-'.$dname) );
+
+ my $linecolor =
+ $self->mkcolor( $config_tree->getNodeParam
+ ($token, 'line-color-'.$dname) );
+
+ my $alpha =
+ $config_tree->getNodeParam($token, 'line-alpha-'.$dname);
+ if( defined( $alpha ) )
+ {
+ $linecolor .= $alpha;
+ }
+
+ my $stack =
+ $config_tree->getNodeParam($token, 'line-stack-'.$dname);
+ if( defined( $stack ) and $stack eq 'yes' )
+ {
+ $stack = ':STACK';
+ }
+ else
+ {
+ $stack = '';
+ }
+
+ push( @{$obj->{'args'}{'line'}},
+ sprintf( '%s:%s%s%s%s', $linestyle, $dname,
+ $linecolor,
+ length($legend) > 0 ? ':'.$legend.'\l' : '',
+ $stack ) );
+
+ }
+ }
+}
+
+
+# Check if Holt-Winters stuff is needed
+sub rrd_check_hw
+{
+ my $self = shift;
+ my $config_tree = shift;
+ my $token = shift;
+ my $view = shift;
+
+ my $use_hw = 0;
+ my $nodeHW = $config_tree->getNodeParam($token, 'rrd-hwpredict');
+ if( defined($nodeHW) and $nodeHW eq 'enabled' )
+ {
+ my $viewHW = $config_tree->getParam($view, 'rrd-hwpredict');
+ my $varNoHW = $self->{'options'}->{'variables'}->{'NOHW'};
+
+ if( (not defined($viewHW) or $viewHW ne 'disabled') and
+ (not $varNoHW) )
+ {
+ $use_hw = 1;
+ }
+ }
+ return $use_hw;
+}
+
+
+sub rrd_make_holtwinters
+{
+ my $self = shift;
+ my $config_tree = shift;
+ my $token = shift;
+ my $view = shift;
+ my $obj = shift;
+
+ my $dname = $obj->{'dname'};
+
+ push( @{$obj->{'args'}{'defs'}},
+ $self->rrd_make_def( $config_tree, $token,
+ $dname . 'pred', 'HWPREDICT' ) );
+ push( @{$obj->{'args'}{'defs'}},
+ $self->rrd_make_def( $config_tree, $token,
+ $dname . 'dev', 'DEVPREDICT' ) );
+ # Upper boundary definition
+ push( @{$obj->{'args'}{'defs'}},
+ sprintf( 'CDEF:%supper=%spred,%sdev,2,*,+',
+ $dname, $dname, $dname ) );
+
+ # Lower boundary definition
+ push( @{$obj->{'args'}{'defs'}},
+ sprintf( 'CDEF:%slower=%spred,%sdev,2,*,-',
+ $dname, $dname, $dname ) );
+
+ # Failures definition
+ push( @{$obj->{'args'}{'defs'}},
+ $self->rrd_make_def( $config_tree, $token,
+ $dname . 'fail', 'FAILURES' ) );
+
+ # Generate H-W Boundary Lines
+
+ # Boundary style
+ my $hw_bndr_style = $config_tree->getParam($view, 'hw-bndr-style');
+ $hw_bndr_style = 'LINE1' unless defined $hw_bndr_style;
+ $hw_bndr_style = $self->mkline( $hw_bndr_style );
+
+ my $hw_bndr_color = $config_tree->getParam($view, 'hw-bndr-color');
+ $hw_bndr_color = '#FF0000' unless defined $hw_bndr_color;
+ $hw_bndr_color = $self->mkcolor( $hw_bndr_color );
+
+ push( @{$obj->{'args'}{'hwline'}},
+ sprintf( '%s:%supper%s:%s',
+ $hw_bndr_style, $dname, $hw_bndr_color,
+ $Torrus::Renderer::hwGraphLegend ? 'Boundaries\n':'' ) );
+ push( @{$obj->{'args'}{'hwline'}},
+ sprintf( '%s:%slower%s',
+ $hw_bndr_style, $dname, $hw_bndr_color ) );
+
+ # Failures Tick
+
+ my $hw_fail_color = $config_tree->getParam($view, 'hw-fail-color');
+ $hw_fail_color = '#FFFFA0' unless defined $hw_fail_color;
+ $hw_fail_color = $self->mkcolor( $hw_fail_color );
+
+ push( @{$obj->{'args'}{'hwtick'}},
+ sprintf( 'TICK:%sfail%s:1.0:%s',
+ $dname, $hw_fail_color,
+ $Torrus::Renderer::hwGraphLegend ? 'Failures':'') );
+}
+
+sub rrd_make_graphline
+{
+ my $self = shift;
+ my $config_tree = shift;
+ my $token = shift;
+ my $view = shift;
+ my $obj = shift;
+
+ my $legend;
+
+ my $disable_legend = $config_tree->getParam($view, 'disable-legend');
+ if( not defined($disable_legend) or $disable_legend ne 'yes' )
+ {
+ $legend = $config_tree->getNodeParam($token, 'graph-legend');
+ if( defined( $legend ) )
+ {
+ $legend =~ s/:/\\:/g;
+ }
+ }
+
+ if( not defined( $legend ) )
+ {
+ $legend = '';
+ }
+
+ my $styleval = $config_tree->getNodeParam($token, 'line-style');
+ if( not defined( $styleval ) or length( $styleval ) == 0 )
+ {
+ $styleval = $config_tree->getParam($view, 'line-style');
+ }
+
+ my $linestyle = $self->mkline( $styleval );
+
+ my $colorval = $config_tree->getNodeParam($token, 'line-color');
+ if( not defined( $colorval ) or length( $colorval ) == 0 )
+ {
+ $colorval = $config_tree->getParam($view, 'line-color');
+ }
+
+ my $linecolor = $self->mkcolor( $colorval );
+
+ if( $self->rrd_if_gprint( $config_tree, $token ) )
+ {
+ $self->rrd_make_gprint_header( $config_tree, $token, $view, $obj );
+
+ $self->rrd_make_gprint( $obj->{'dname'}, $legend,
+ $config_tree, $token, $view, $obj );
+ }
+
+ push( @{$obj->{'args'}{'line'}},
+ sprintf( '%s:%s%s%s', $linestyle, $obj->{'dname'}, $linecolor,
+ length($legend) > 0 ? ':'.$legend.'\l' : '' ) );
+}
+
+
+# Generate RRDtool arguments for HRULE's
+
+sub rrd_make_hrules
+{
+ my $self = shift;
+ my $config_tree = shift;
+ my $token = shift;
+ my $view = shift;
+ my $obj = shift;
+
+ my $hrulesList = $config_tree->getParam($view, 'hrules');
+ if( defined( $hrulesList ) )
+ {
+ foreach my $hruleName ( split(',', $hrulesList ) )
+ {
+ # The presence of this parameter is checked by Validator
+ my $valueParam =
+ $config_tree->getParam( $view, 'hrule-value-'.$hruleName );
+ my $value = $config_tree->getNodeParam( $token, $valueParam );
+
+ if( defined( $value ) )
+ {
+ my $color =
+ $config_tree->getParam($view, 'hrule-color-'.$hruleName);
+ $color = $self->mkcolor( $color );
+
+ my $legend =
+ $config_tree->getNodeParam($token,
+ 'hrule-legend-'.$hruleName);
+
+ my $arg = sprintf( 'HRULE:%e%s', $value, $color );
+ if( defined( $legend ) and $legend =~ /\S/ )
+ {
+ $arg .= ':' . $legend . '\l';
+ }
+ push( @{$obj->{'args'}{'hrule'}}, $arg );
+ }
+ }
+ }
+}
+
+
+sub rrd_make_decorations
+{
+ my $self = shift;
+ my $config_tree = shift;
+ my $token = shift;
+ my $view = shift;
+ my $obj = shift;
+
+ my $decorList = $config_tree->getParam($view, 'decorations');
+ my $ignore_decor =
+ $config_tree->getNodeParam($token, 'graph-ignore-decorations');
+ if( defined( $decorList ) and
+ (not defined($ignore_decor) or $ignore_decor ne 'yes') )
+ {
+ my $decor = {};
+ foreach my $decorName ( split(',', $decorList ) )
+ {
+ my $order =
+ $config_tree->getParam($view, 'dec-order-' . $decorName);
+ $decor->{$order} = {'def' => [], 'line' => ''};
+
+ my $style =
+ $self->mkline( $config_tree->
+ getParam($view, 'dec-style-' . $decorName) );
+ my $color =
+ $self->mkcolor( $config_tree->
+ getParam($view, 'dec-color-' . $decorName) );
+ my $expr = $config_tree->
+ getParam($view, 'dec-expr-' . $decorName);
+
+ push( @{$decor->{$order}{'def'}},
+ $self->rrd_make_cdef( $config_tree, $token, $decorName,
+ $obj->{'dname'} . ',POP,' . $expr ) );
+
+ $decor->{$order}{'line'} =
+ sprintf( '%s:%s%s', $style, $decorName, $color );
+ }
+
+ foreach my $order ( sort {$a<=>$b} keys %{$decor} )
+ {
+ my $array = $order < 0 ? 'bg':'fg';
+
+ push( @{$obj->{'args'}{'defs'}}, @{$decor->{$order}{'def'}} );
+ push( @{$obj->{'args'}{$array}}, $decor->{$order}{'line'} );
+ }
+ }
+}
+
+# Takes the parameters from the view, and composes the list of
+# RRDtool arguments
+
+sub rrd_make_opts
+{
+ my $self = shift;
+ my $config_tree = shift;
+ my $token = shift;
+ my $view = shift;
+ my $opthash = shift;
+
+ my @args = ();
+ foreach my $param ( keys %{$opthash} )
+ {
+ my $value =
+ $self->{'options'}->{'variables'}->{'G' . $param};
+
+ if( not defined( $value ) )
+ {
+ $value = $config_tree->getParam( $view, $param );
+ }
+
+ if( defined( $value ) )
+ {
+ if( ( $param eq 'start' or $param eq 'end' ) and
+ defined( $self->{'options'}->{'variables'}->{'NOW'} ) )
+ {
+ my $now = $self->{'options'}->{'variables'}->{'NOW'};
+ if( index( $value , 'now' ) >= 0 )
+ {
+ $value =~ s/now/$now/;
+ }
+ elsif( $value =~ /^(\-|\+)/ )
+ {
+ $value = $now . $value;
+ }
+ }
+ push( @args, $opthash->{$param}, $value );
+ }
+ }
+
+ my $params = $config_tree->getParam($view, 'rrd-params');
+ if( defined( $params ) )
+ {
+ push( @args, split('\s+', $params) );
+ }
+
+ my $scalingbase = $config_tree->getNodeParam($token, 'rrd-scaling-base');
+ if( defined($scalingbase) and $scalingbase == 1024 )
+ {
+ push( @args, '--base', '1024' );
+ }
+
+ return @args;
+}
+
+
+sub rrd_make_graph_opts
+{
+ my $self = shift;
+ my $config_tree = shift;
+ my $token = shift;
+ my $view = shift;
+
+ my @args = ( '--imgformat', 'PNG' );
+
+ my $graph_log = $config_tree->getNodeParam($token, 'graph-logarithmic');
+ if( defined($graph_log) and $graph_log eq 'yes' )
+ {
+ push( @args, '--logarithmic' );
+ }
+
+ my $disable_title =
+ $config_tree->getParam($view, 'disable-title');
+ if( not defined( $disable_title ) or $disable_title ne 'yes' )
+ {
+ my $title = $config_tree->getNodeParam($token, 'graph-title');
+ if( not defined( $title ) or length( $title ) == 0 )
+ {
+ $title = ' ';
+ }
+ push( @args, '--title', $title );
+ }
+
+ my $disable_vlabel =
+ $config_tree->getParam($view, 'disable-vertical-label');
+ if( not defined( $disable_vlabel ) or $disable_vlabel ne 'yes' )
+ {
+ my $vertical_label =
+ $config_tree->getNodeParam($token, 'vertical-label');
+ if( defined( $vertical_label ) and length( $vertical_label ) > 0 )
+ {
+ push( @args, '--vertical-label', $vertical_label );
+ }
+ }
+
+ my $ignore_limits = $config_tree->getParam($view, 'ignore-limits');
+ if( not defined($ignore_limits) or $ignore_limits ne 'yes' )
+ {
+ my $ignore_lower = $config_tree->getParam($view, 'ignore-lower-limit');
+ if( not defined($ignore_lower) or $ignore_lower ne 'yes' )
+ {
+ my $limit =
+ $config_tree->getNodeParam($token, 'graph-lower-limit');
+ if( defined($limit) and length( $limit ) > 0 )
+ {
+ push( @args, '--lower-limit', $limit );
+ }
+ }
+
+ my $ignore_upper = $config_tree->getParam($view, 'ignore-upper-limit');
+ if( not defined($ignore_upper) or $ignore_upper ne 'yes' )
+ {
+ my $limit =
+ $config_tree->getNodeParam($token, 'graph-upper-limit');
+ if( defined($limit) and length( $limit ) > 0 )
+ {
+ push( @args, '--upper-limit', $limit );
+ }
+ }
+
+ my $rigid_boundaries =
+ $config_tree->getNodeParam($token, 'graph-rigid-boundaries');
+ if( defined($rigid_boundaries) and $rigid_boundaries eq 'yes' )
+ {
+ push( @args, '--rigid' );
+ }
+ }
+
+ if( scalar( @Torrus::Renderer::graphExtraArgs ) > 0 )
+ {
+ push( @args, @Torrus::Renderer::graphExtraArgs );
+ }
+
+ return @args;
+}
+
+
+sub rrd_make_def
+{
+ my $self = shift;
+ my $config_tree = shift;
+ my $token = shift;
+ my $dname = shift;
+ my $cf = shift;
+
+ my $datafile = $config_tree->getNodeParam($token, 'data-file');
+ my $dataddir = $config_tree->getNodeParam($token, 'data-dir');
+ my $rrdfile = $dataddir.'/'.$datafile;
+ if( not -r $rrdfile )
+ {
+ my $path = $config_tree->path($token);
+ Error("$path: No such file or directory: $rrdfile");
+ return undef;
+ }
+
+ my $ds = $config_tree->getNodeParam($token, 'rrd-ds');
+ if( not defined $cf )
+ {
+ $cf = $config_tree->getNodeParam($token, 'rrd-cf');
+ }
+ return sprintf( 'DEF:%s=%s:%s:%s',
+ $dname, $rrdfile, $ds, $cf );
+}
+
+
+
+my %cfNames =
+ ( 'AVERAGE' => 1,
+ 'MIN' => 1,
+ 'MAX' => 1,
+ 'LAST' => 1 );
+
+# Moved the validation part to Torrus::ConfigTree::Validator
+sub rrd_make_cdef
+{
+ my $self = shift;
+ my $config_tree = shift;
+ my $token = shift;
+ my $dname = shift;
+ my $expr = shift;
+
+ my @args = ();
+
+ # We will name the DEFs as $dname.sprintf('%.2d', $ds_couter++);
+ my $ds_couter = 1;
+
+ my $rpn = new Torrus::RPN;
+
+ # The callback for RPN translation
+ my $callback = sub
+ {
+ my ($noderef, $timeoffset) = @_;
+
+ my $function;
+ if( $noderef =~ s/^(.+)\@// )
+ {
+ $function = $1;
+ }
+
+ my $cf;
+ if( defined( $function ) and $cfNames{$function} )
+ {
+ $cf = $function;
+ }
+
+ my $leaf = length($noderef) > 0 ?
+ $config_tree->getRelative($token, $noderef) : $token;
+
+ my $varname = $dname . sprintf('%.2d', $ds_couter++);
+ push( @args,
+ $self->rrd_make_def( $config_tree, $leaf, $varname, $cf ) );
+ return $varname;
+ };
+
+ $expr = $rpn->translate( $expr, $callback );
+ push( @args, sprintf( 'CDEF:%s=%s', $dname, $expr ) );
+ return @args;
+}
+
+
+sub rrd_if_gprint
+{
+ my $self = shift;
+ my $config_tree = shift;
+ my $token = shift;
+
+ my $disable = $config_tree->getNodeParam($token, 'graph-disable-gprint');
+ if( defined( $disable ) and $disable eq 'yes' )
+ {
+ return 0;
+ }
+ return 1;
+}
+
+sub rrd_make_gprint
+{
+ my $self = shift;
+ my $vname = shift;
+ my $legend = shift;
+ my $config_tree = shift;
+ my $token = shift;
+ my $view = shift;
+ my $obj = shift;
+
+ my @args = ();
+
+ my $gprintValues = $config_tree->getParam($view, 'gprint-values');
+ if( defined( $gprintValues ) and length( $gprintValues ) > 0 )
+ {
+ foreach my $gprintVal ( split(',', $gprintValues ) )
+ {
+ my $format =
+ $config_tree->getParam($view, 'gprint-format-' . $gprintVal);
+ push( @args, 'GPRINT:' . $vname . ':' . $format );
+ }
+ }
+
+ push( @{$obj->{'args'}{'line'}}, @args );
+}
+
+
+sub rrd_make_gprint_header
+{
+ my $self = shift;
+ my $config_tree = shift;
+ my $token = shift;
+ my $view = shift;
+ my $obj = shift;
+
+ my $gprintValues = $config_tree->getParam($view, 'gprint-values');
+ if( defined( $gprintValues ) and length( $gprintValues ) > 0 )
+ {
+ my $gprintHeader = $config_tree->getParam($view, 'gprint-header');
+ if( defined( $gprintHeader ) and length( $gprintHeader ) > 0 )
+ {
+ push( @{$obj->{'args'}{'line'}},
+ 'COMMENT:' . $gprintHeader . '\l' );
+ }
+ }
+}
+
+
+sub mkcolor
+{
+ my $self = shift;
+ my $color = shift;
+
+ my $recursionLimit = 100;
+
+ while( $color =~ /^\#\#(\S+)$/ )
+ {
+ if( $recursionLimit-- <= 0 )
+ {
+ Error('Color recursion is too deep');
+ $color = '#000000';
+ }
+ else
+ {
+ my $colorName = $1;
+ $color = $Torrus::Renderer::graphStyles{$colorName}{'color'};
+ if( not defined( $color ) )
+ {
+ Error('No color is defined for ' . $colorName);
+ $color = '#000000';
+ }
+ }
+ }
+ return $color;
+}
+
+sub mkline
+{
+ my $self = shift;
+ my $line = shift;
+
+ if( $line =~ /^\#\#(\S+)$/ )
+ {
+ my $lineName = $1;
+ $line = $Torrus::Renderer::graphStyles{$lineName}{'line'};
+ if( not defined( $line ) )
+ {
+ Error('No line style is defined for ' . $lineName);
+ $line = 'LINE1';
+ }
+ }
+ return $line;
+}
+
+
+sub tz_set
+{
+ my $self = shift;
+
+ if( defined $ENV{'TZ'} )
+ {
+ Debug("Previous TZ value: " . $ENV{'TZ'});
+ $self->{'tz_defined'} = 1;
+ }
+ else
+ {
+ $self->{'tz_defined'} = 0;
+ }
+
+ if( defined( my $newTZ = $self->{'options'}->{'variables'}->{'TZ'} ) )
+ {
+ Debug("Setting TZ to " . $newTZ);
+ $self->{'tz_old'} = $ENV{'TZ'};
+ $ENV{'TZ'} = $newTZ;
+ $self->{'tz_changed'} = 1;
+ }
+ else
+ {
+ $self->{'tz_changed'} = 0;
+ }
+}
+
+sub tz_restore
+{
+ my $self = shift;
+
+ if( $self->{'tz_changed'} )
+ {
+ if( $self->{'tz_defined'} )
+ {
+ Debug("Restoring TZ back to " . $self->{'tz_old'});
+ $ENV{'TZ'} = $self->{'tz_old'};
+ }
+ else
+ {
+ Debug("Restoring TZ back to undefined");
+ delete $ENV{'TZ'};
+ }
+ }
+}
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
generated by cgit v1.2.1 (git 2.18.0) at 2024-10-05 17:47:24 +0000