# -*- perl -*-
package Smokeping::Graphs;
use strict;
use Smokeping;
=head1 NAME
Smokeping::Graphs - Functions used in Smokeping for creating graphs
=head1 OVERVIEW
This module currently only contains the code for generating the 'multi target' graphs.
Code for the other graphs will be moved here too in time.
=head2 IMPLEMENTATION
=head3 get_multi_detail
A version of get_detail for multi host graphs where there is data from
multiple targets shown in one graph. The look of the graph is modeld after
the graphs shown in the overview page, except for the size.
=cut
sub get_multi_detail ($$$$;$){
# a) 's' classic with several static graphs on the page
# b) 'n' navigator mode with one graph. below the graph one can specify the end time
# and the length of the graph.
# c) 'a' ajax mode, generate image based on given url and dump in on stdout
#
my $cfg = shift;
my $q = shift;
my $tree = shift;
my $open = shift;
my $mode = shift || $q->param('displaymode') || 's';
my $phys_open = $open;
if ($tree->{__tree_link}){
$tree=$tree->{__tree_link};
$phys_open = $tree->{__real_path};
}
my @dirs = @{$phys_open};
return "
ERROR: ".(join ".", @dirs)." has no probe defined
"
unless $tree->{probe};
return "ERROR: ".(join ".", @dirs)." $tree->{probe} is not known
"
unless $cfg->{__probes}{$tree->{probe}};
return "ERROR: ".(join ".", @dirs)." ist no multi host
"
unless $tree->{host} =~ m|^/|;
return "ERROR: unknown displaymode $mode
"
unless $mode =~ /^[snca]$/;
my $dir = "";
for (@dirs) {
$dir .= "/$_";
mkdir $cfg->{General}{imgcache}.$dir, 0755
unless -d $cfg->{General}{imgcache}.$dir;
die "ERROR: creating $cfg->{General}{imgcache}$dir: $!\n"
unless -d $cfg->{General}{imgcache}.$dir;
}
my $page;
my $file = pop @dirs;
my @hosts = split /\s+/, $tree->{host};
my $ProbeDesc;
my $ProbeUnit;
my $imgbase;
my $imghref;
my @tasks;
my %lastheight;
my $max = {};
if ($mode eq 's'){
# in nav mode there is only one graph, so the height calculation
# is not necessary.
$imgbase = $cfg->{General}{imgcache}."/".(join "/", @dirs)."/${file}";
$imghref = $cfg->{General}{imgurl}."/".(join "/", @dirs)."/${file}";
@tasks = @{$cfg->{Presentation}{detail}{_table}};
if (open (HG,"<${imgbase}.maxheight")){
while (){
chomp;
my @l = split / /;
$lastheight{$l[0]} = $l[1];
}
close HG;
}
for my $rrd (@hosts){
my $newmax = Smokeping::findmax($cfg, $cfg->{General}{datadir}.$rrd.".rrd");
map {$max->{$_} = $newmax->{$_} if not $max->{$_} or $newmax->{$_} > $max->{$_} } keys %{$newmax};
}
if (open (HG,">${imgbase}.maxheight")){
foreach my $size (keys %{$max}){
print HG "$size $max->{$size}\n";
}
close HG;
}
}
elsif ($mode eq 'n' or $mode eq 'a') {
if ($mode eq 'n') {
$imgbase =$cfg->{General}{imgcache}."/__navcache/".time()."$$";
$imghref =$cfg->{General}{imgurl}."/__navcache/".time()."$$";
} else {
my $serial = int(rand(2000));
$imgbase =$cfg->{General}{imgcache}."/__navcache/".$serial;
$imghref =$cfg->{General}{imgurl}."/__navcache/".$serial;
}
mkdir $cfg->{General}{imgcache}."/__navcache",0755 unless -d $cfg->{General}{imgcache}."/__navcache";
# remove old images after one hour
my $pattern = $cfg->{General}{imgcache}."/__navcache/*.png";
for (glob $pattern){
unlink $_ if time - (stat $_)[9] > 3600;
}
@tasks = (["Navigator Graph", Smokeping::parse_datetime($q->param('start')),Smokeping::parse_datetime($q->param('end'))]);
} else {
# chart mode
mkdir $cfg->{General}{imgcache}."/__chartscache",0755 unless -d $cfg->{General}{imgcache}."/__chartscache";
# remove old images after one hour
my $pattern = $cfg->{General}{imgcache}."/__chartscache/*.png";
for (glob $pattern){
unlink $_ if time - (stat $_)[9] > 3600;
}
my $desc = join "/",@{$open};
@tasks = ([$desc , time()-3600, time()]);
$imgbase = $cfg->{General}{imgcache}."/__chartscache/".(join ".", @dirs).".${file}";
$imghref = $cfg->{General}{imgurl}."/__chartscache/".(join ".", @dirs).".${file}";
}
if ($mode =~ /[anc]/){
my $val = 0;
for my $host (@hosts){
my ($graphret,$xs,$ys) = RRDs::graph
("dummy",
'--start', $tasks[0][1],
'--end', $tasks[0][2],
"DEF:maxping=$cfg->{General}{datadir}${host}.rrd:median:AVERAGE",
'PRINT:maxping:MAX:%le' );
my $ERROR = RRDs::error();
return "RRDtool did not understand your input: $ERROR.
" if $ERROR;
$val = $graphret->[0] if $val < $graphret->[0];
}
$val = 1e-6 if $val =~ /nan/i;
$max = { $tasks[0][1] => $val * 1.5 };
}
for (@tasks) {
my ($desc,$start,$end) = @{$_};
my $xs;
my $ys;
my $sigtime = ($end and $end =~ /^\d+$/) ? $end : time;
my $date = $cfg->{Presentation}{detail}{strftime} ?
POSIX::strftime($cfg->{Presentation}{detail}{strftime}, localtime($sigtime)) : scalar localtime($sigtime);
if ( $RRDs::VERSION >= 1.199908 ){
$date =~ s|:|\\:|g;
}
$end ||= 'last';
$start = Smokeping::exp2seconds($start) if $mode =~ /[s]/;
my $startstr = $start =~ /^\d+$/ ? POSIX::strftime("%Y-%m-%d %H:%M",localtime($mode eq 'n' ? $start : time-$start)) : $start;
my $endstr = $end =~ /^\d+$/ ? POSIX::strftime("%Y-%m-%d %H:%M",localtime($mode eq 'n' ? $end : time)) : $end;
my $realstart = ( $mode =~ /[sc]/ ? '-'.$start : $start);
my @G;
my @colors = split /\s+/, $cfg->{Presentation}{multihost}{colors};
my $i = 0;
for my $host (@hosts){
$i++;
my $swidth = $max->{$start} / $cfg->{Presentation}{detail}{height};
my $rrd = $cfg->{General}{datadir}.$host.".rrd";
next unless -r $rrd; # skip things that do not exist;
my $medc = shift @colors;
my @tree_path = split /\//,$host;
shift @tree_path;
my ($host,$real_slave) = split /~/, $tree_path[-1]; #/
$tree_path[-1] = $host;
my $tree = Smokeping::get_tree($cfg,\@tree_path);
my $label = $tree->{menu};
if ($real_slave){
$label .= "<". $cfg->{Slaves}{$real_slave}{display_name};
}
my $probe = $cfg->{__probes}{$tree->{probe}};
my $XProbeDesc = $probe->ProbeDesc();
if (not $ProbeDesc or $ProbeDesc eq $XProbeDesc){
$ProbeDesc = $XProbeDesc;
}
else {
$ProbeDesc = "various probes";
}
my $XProbeUnit = $probe->ProbeUnit();
if (not $ProbeUnit or $ProbeUnit eq $XProbeUnit){
$ProbeUnit = $XProbeUnit;
}
else {
$ProbeUnit = "various units";
}
my $pings = $probe->_pings($tree);
$label = sprintf("%-20s",$label);
push @colors, $medc;
my $sdc = $medc;
my $stddev = Smokeping::RRDhelpers::get_stddev($rrd,'median','AVERAGE',$realstart,$sigtime) || 0;
$sdc =~ s/^(......).*/${1}30/;
push @G,
"DEF:median$i=${rrd}:median:AVERAGE",
"DEF:loss$i=${rrd}:loss:AVERAGE",
"CDEF:ploss$i=loss$i,$pings,/,100,*",
"CDEF:dm$i=median$i,0,".$max->{$start}.",LIMIT",
Smokeping::calc_stddev($rrd,$i,$pings),
"CDEF:dmlow$i=dm$i,sdev$i,2,/,-",
"CDEF:s2d$i=sdev$i",
# "CDEF:dm2=median,1.5,*,0,$max,LIMIT",
# "LINE1:dm2", # this is for kicking things down a bit
"AREA:dmlow$i",
"AREA:s2d${i}#${sdc}::STACK",
"LINE1:dm$i#${medc}:${label}",
"VDEF:avmed$i=median$i,AVERAGE",
"VDEF:avsd$i=sdev$i,AVERAGE",
"CDEF:msr$i=median$i,POP,avmed$i,avsd$i,/",
"VDEF:avmsr$i=msr$i,AVERAGE",
"GPRINT:avmed$i:%5.1lf %ss av md ",
"GPRINT:ploss$i:AVERAGE:%5.1lf %% av ls",
sprintf('COMMENT:%5.1lf ms sd',$stddev*1000.0),
"GPRINT:avmsr$i:%5.1lf %s am/as\\l";
};
my @task;
push @task, "--logarithmic" if $cfg->{Presentation}{detail}{logarithmic} and
$cfg->{Presentation}{detail}{logarithmic} eq 'yes';
push @task, '--lazy' if $mode eq 's' and $lastheight{$start} == $max->{$start};
push @task,
"${imgbase}_${end}_${start}.png",
'--start',$realstart,
($end ne 'last' ? ('--end',$end) : ()),
'--height',$cfg->{Presentation}{detail}{height},
'--width',$cfg->{Presentation}{detail}{width},
'--title',$desc,
'--rigid','--upper-limit', $max->{$start},
'--lower-limit',($cfg->{Presentation}{detail}{logarithmic} ? ($max->{$start} > 0.01) ? '0.001' : '0.0001' : '0'),
'--vertical-label',$ProbeUnit,
'--imgformat','PNG',
'--color', 'SHADEA#ffffff',
'--color', 'SHADEB#ffffff',
'--color', 'BACK#ffffff',
'--color', 'CANVAS#ffffff',
@G,
"COMMENT:$ProbeDesc",
'COMMENT:end\: '.$date.'\j';
my $graphret;
($graphret,$xs,$ys) = RRDs::graph @task;
# print "INFO:".join("
",@task)."
";
my $ERROR = RRDs::error();
if ($ERROR) {
return "ERROR: $ERROR
".join("
",@task)."
";
};
if ($mode eq 'a'){ # ajax mode
open my $img, "${imgbase}_${end}_${start}.png";
binmode $img;
print "Content-Type: image/png\n";
my $data;
read($img,$data,(stat($img))[7]);
close $img;
print "Content-Length: ".length($data)."\n\n";
print $data;
unlink "${imgbase}_${end}_${start}.png";
exit;
}
elsif ($mode eq 'n'){ # navigator mode
# $page .= qq||;
$page .= qq|
| ;
# $page .= "
";
$page .= $q->start_form(-method=>'GET', -id=>'range_form')
. "Time range: "
. $q->textfield(-name=>'start',-default=>$startstr)
. " to ".$q->textfield(-name=>'end',-default=>$endstr)
. $q->hidden(-name=>'epoch_start',-id=>'epoch_start',-default=>$start)
. $q->hidden(-name=>'epoch_end',-id=>'epoch_end',-default=>time())
. $q->hidden(-name=>'target',-id=>'target' )
. $q->hidden(-name=>'hierarchy',-id=>'hierarchy' )
. $q->hidden(-name=>'displaymode',-default=>$mode )
. " "
. $q->submit(-name=>'Generate!')
. "
"
. $q->end_form();
} elsif ($mode eq 's') { # classic mode
$startstr =~ s/\s/%20/g;
$endstr =~ s/\s/%20/g;
$page .= "";
# $page .= (time-$timer_start)."
";
# $page .= join " ",map {"'$_'"} @task;
$page .= "
";
$page .= ( qq{
'
. qq{}."" ); #"
$page .= "
";
} else { # chart mode
$page .= "";
}
}
return $page;
}
1;
__END__
=head1 COPYRIGHT
Copyright 2007 by Tobias Oetiker
=head1 LICENSE
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., 675 Mass Ave, Cambridge, MA
02139, USA.
=head1 AUTHOR
Tobias Oetiker Etobi@oetiker.chE
=cut