#!/usr/local/bin/perl -w
#
# rrdbar.cgi : Version 0.1 
#
# Tested with RRDTool v1.0.24
#
# Create single bar GIF/PNG for given DS in RRD

use strict;
use CGI;
use GD;
use RRDs;

my ($VERSION) = "0.1";

##############################################################################
# You MUST set this to the location of the configuration file!
#
my ($conffile) = "/usr/local/etc/webdev.conf";
##############################################################################

my (%config) = ();
my ( $q );
my ( $rrd );
my ( $info ) = ""; # this is set when/if we have to make an info call to rrd
my ( @ds, %dsinfo, $numbars ); # data source config
my ( $max, @max, $defmax, $dsname, @colours, $laststyle );

# initialize CGI
$q = new CGI;
$q->import_names('CGI');

#################################
# given a #xxxxxx colour, return the three byte array
sub coloursplit($)
{
	my ( @c ) = ( 0,0,0 );
	if($_[0] =~ /#(......)/ ) {
		@c = unpack "a2a2a2", $1;
		foreach (@c) { $_ = hex; }
	} 
	return @c;
}

#################################
# Get the info structure
sub getinfo()
{
	my($e);
	return if($info);
	$info = RRDs::info($rrd);
	$e = RRDs::error;
	if($e) { errormessage("RRD: $e"); exit 0; }
}

#################################
# find out the DS names.
sub dsnames()
{ 
	return ("ds0","ds1");
}

#################################
# get the max value for a given ds
sub getmaxval($)
{
	my($rv);
	getinfo if(!$info);
	if( ! ${$info}{"ds[$_[0]].type"} ) {
		errormessage("No such DS '$_[0]' in RRD $rrd");
		exit 0;
	}
	$rv = ${$info}{"ds[$_[0]].max"};
	$rv = 0 if(!$rv);
	return $rv;
}

#################################
# Generate an error message graphic and send it
sub errormessage($)
{
	my( $black, $white, $h );
	my $gd;

	$h = GD::Font->Small->height+2;
	$h = $config{'rrdbar-width'} if($config{'rrdbar-width'}>$h);

	$gd = new GD::Image($config{'rrdbar-length'},$h);
	$black=$gd->colorAllocate(0,0,0);
	$white=$gd->colorAllocate(255,255,255);
	$gd->fill(0,0,$white);
	$gd->string(GD::Font->Small,1,1,$_[0],$black);

	print $q->header({ -type=>"image/png", -pragma=>"nocache", 
		-expires=>"now" });
	binmode STDOUT;
	print $gd->png();

}

#################################
# Read in confgiuration file

# readconf: pass it a list of section names
sub readconf(@)
{
	my ($inlist, $i, @secs, $sec);
	
	@secs = @_;
	%config = ();

	# set defaults
	%config = (
		'rrdbar-interval' => "5min",
		'rrdbar-rrdpath' => "",
		'rrdbar-rrd' => "default.rrd",
		'rrdbar-ds' => "ds0 -ds1", # ds, +ds (stack), -ds (line) ...
		'rrdbar-barcolour' => "#00ff00 #0000ff #ff0000 #00cccc #cc00cc #cccc00",
		'rrdbar-warncolour' => "#ffff00",
		'rrdbar-warnpercent' => "100",
		'rrdbar-labelstyle' => "1",
		'rrdbar-average' => "1d",
		'rrdbar-width' => "10",
		'rrdbar-length' => "400"
	);

	( open CFH, "<".$conffile ) || do {
		errormessage("Cannot read $conffile");
		exit(1);
	};

	$inlist=0;
	$sec = "";
	while( <CFH> ) {
		/^\s*#/ && next;
		/\[(\S*)\]/ && do { 
			$sec = $1;
			$inlist=0;	
			foreach $i ( @secs ) {
				if ( $i eq $1 ) { $inlist=1; last; }
			}
			next ;
		};
		if ( $inlist ) { /(\w+)\s*=\s*(\S.*)$/ and $config{"$sec-$1"}=$2; }
	}

	$config{'rrdbar-rrdpath'} .= '/';
}

#################################
# Make the label for the end of the bar
#   style: 0=none, 1=percent, 2=value, 3=both
#   cur,curpc
sub make_label($$)
{
	my ( $label, $ls );

	$ls = $config{'rrdbar-labelstyle'};

	$label = "";
	if($ls == 1 ) {
		$label = sprintf "%2.1f%%", $_[1];
	} elsif( $ls == 2 ) {
		$label = sprintf "%d", $_[0];
	} elsif( $ls == 3 ) {
		$label = sprintf "%d (%2.1f%%)", $_[0],$_[1];
	}

	return $label;
}

#################################
# Fetch the data into the %dsinfo
# The info we need: current value of ds.
sub fetchdata()
{
	my($interval,$e);
	my($values,$varray,$start,$step,$names,%vals);

	$interval = $config{'rrdbar-interval'};

	# fetch data
	( $start, $step, $names, $values ) = 
		RRDs::fetch($rrd,"AVERAGE","-s","now-$interval","-e","now-$interval");
	# trap errors
	$e = RRDs::error;
	if($e) {
		errormessage("RRD: $e");
		exit(0);
	}
	# now we load %vals so that we can look them up.
	%vals = ();
	$varray = ${$values}[0];
	foreach (@$names) { 
		$vals{$_}=${$varray}[0];
		$vals{$_}="NaN" if($vals{$_} eq "");
		shift @$varray;
	}
	foreach (@ds) {
		if ( !defined $vals{$_} ) { 
			errormessage("DS name '".$_."' not found in RRD");		
			exit(0);
		}
		$dsinfo{$_}{value} = $vals{$_};
		$dsinfo{$_}{pc} = $vals{$_}/$dsinfo{$_}{max}*100.0;
	}

	# ok, now, we have data in %dsinfo for all ds's in @ds.
}

#################################
# Generate the graphic bar
# At this point, we know 
#   - the name of the RRD file
#   - the name of the DSs
#   - the max value for the DSs
#   - all the other defaults for graphic style etc.
# on error, call errormessage() and exit.
sub makegraphic()
{
	my($gd, $h, $w, $label, $labely, $bary, $barw, $barn);
	my($black, $white, $grey, $barcolour, $avgcolour, $bgcolour, $pink );
	my( $current, $currentpc );
	my( $e, $x, $fx,  $i, $dsn );

# Make the graphic
	$h = $config{'rrdbar-width'};
	$w = $config{'rrdbar-length'};
	$bary = 0;
	if( $config{'rrdbar-labelstyle'} ) {
		if((GD::Font->Small->height+2)>$h){
			$bary = ( GD::Font->Small->height+2 - $h )/2;
			$h = GD::Font->Small->height+2 
		}
		$w += 7 * GD::Font->Small->width * (1+$#ds);
	}
	$gd = new GD::Image($w,$h);
	$black=$gd->colorAllocate(0,0,0); # bar border
	$white=$gd->colorAllocate(255,255,255); # bar background
	$grey=$gd->colorAllocate(192,192,192); # for if data UNKNOWN
	$pink=$gd->colorAllocate(255,192,192); # bar background above WARN level
	$bgcolour=$gd->colorAllocate(224,224,224); # graphic background (trans)
	$label = "";

	# draw the background (transparent)
	$gd->transparent($bgcolour);
	$gd->fill(1,1,$bgcolour);

	# draw the bar
	$gd->rectangle(0,0+$bary,
		$config{'rrdbar-length'}-1,$config{'rrdbar-width'}-1+$bary,$black);
	$gd->fill(1,1+$bary,$white);
	if( $config{'rrdbar-warnpercent'} < 100 ) {
		$x=$config{'rrdbar-warnpercent'}/100.0*$config{'rrdbar-length'};
		$gd->line($x,1+$bary,
			 $x,$config{'rrdbar-width'}-2+$bary,$pink) if($x>0);
		$gd->fill(1,1+$bary,$pink);
	}

	# draw on the data
	# loop through for each DS given in the config
	$barw = ($config{'rrdbar-width'}-2)/$numbars if($numbars); # bar width
	$barn = -1; # count of bars done so far
	$label = "";
	foreach $dsn ( @ds ) {
		if(!$dsinfo{$dsn}{stack} and !$dsinfo{$dsn}{line}) { $barn++; }
		$barcolour=$gd->colorAllocate(coloursplit($dsinfo{$dsn}{colour}));
		$currentpc = 0.0 if(! $dsinfo{$dsn}{stack} );
		# do label
		if( $config{'rrdbar-labelstyle'} ) {
			$label .= make_label($dsinfo{$dsn}{value},$dsinfo{$dsn}{pc})." ";
		}
		# get value
		next if ($currentpc >= 100);
		next if ($dsinfo{$dsn}{value} eq "NaN" );
		if( ($currentpc > 0) and !$dsinfo{$dsn}{line} ) {
			$fx=$currentpc/100.0*$config{'rrdbar-length'}+1;
		} else { $fx = 1; }
		$currentpc += $dsinfo{$dsn}{pc};
		$current    = $dsinfo{$dsn}{value};
		$currentpc = 100 if( $currentpc > 100 );

		$x=$currentpc/100.0*$config{'rrdbar-length'};

		if( $dsinfo{$dsn}{line} ) {
			$gd->line($x,1+$bary,
				$x,$config{'rrdbar-width'}-2+$bary,$barcolour) if($x>0);
		} else {
			$gd->rectangle($fx,1+$bary+($barw*$barn),
				$x,($barw*$barn)+$barw+$bary,$barcolour) if($x>0);
			$gd->fill($x-1,2+$bary+($barw*$barn),$barcolour) if(($x-$fx)>1);
		}
	} # loop through ds

	if( $config{'rrdbar-labelstyle'} ) {
		$labely = ($h - GD::Font->Small->height)/2;
		$labely = 1 if($labely<1);
		$gd->string(GD::Font->Small,
			$config{'rrdbar-length'}+5,$labely,$label,$black);
	}

# we now have a graphic, give the http headers and send it
	print $q->header({ -type=>"image/png", -expires=>"+5m" });
	binmode STDOUT;
	print $gd->png();
}

########################################################################
# Initialise parameters

# get these sections from the conf file.
readconf('rrdbar'); 

# check for CGI parameters overriding the conf file and defaults
# also these should define/set the rrd and ds params.
if( $CGI::RRD ) { $config{'rrdbar-rrd'} = $CGI::RRD; }
if( @CGI::DS  ) { $config{'rrdbar-ds' } = join " ",@CGI::DS;  }
if( @CGI::MAX ) { $config{'rrdbar-max'} = join " ",@CGI::MAX; }
if( $CGI::I   ) { $config{'rrdbar-interval'} = $CGI::I; }
if( $CGI::T   ) { $config{'rrdbar-interval'} = $CGI::T; }
if( defined $CGI::L   ) { $config{'rrdbar-labelstyle'} = $CGI::L  ; }
if( defined $CGI::LAB ) { $config{'rrdbar-labelstyle'} = $CGI::LAB; }
if( $CGI::WID ) { $config{'rrdbar-width'} = $CGI::WID; }
if( $CGI::LEN ) { $config{'rrdbar-length'} = $CGI::LEN; }

# now set up the @ds and %dsinfo values ready to make the bar graph.
$rrd = $config{'rrdbar-rrdpath'}.$config{'rrdbar-rrd'};
@colours = split " ", $config{'rrdbar-barcolour'};
@ds = split " ", $config{'rrdbar-ds'};
if( $#ds < 0 ) { errormessage("No data sources specified."); exit(0); }
if( $#colours < 0 ) { errormessage("No colours specified."); exit(0); }
while( $#colours < $#ds ) { push @colours, @colours; }
@max = split " ", $config{'rrdbar-max'};
$defmax = 0;
$defmax = $max[0] if ( $#max == 0 );
if( !@ds ) { @ds = dsnames(); }; # from info
$laststyle = 0;
$numbars = 0;
foreach $dsname (@ds) {
	if( $dsname =~ /^[\+@](.*)/ ) {
		$dsname = $1;
		$dsinfo{$1}{stack} = 1;
		$dsinfo{$1}{line} = $laststyle;
	} else { 
		$laststyle = 0;
		$dsinfo{$1}{stack} = 0;
		if( $dsname =~ /^-(.*)/ ) {
			$dsname = $1;
			$dsinfo{$1}{line} = 1;
			$laststyle = 1;
		} else {
			$numbars++;
			$dsinfo{$1}{line} = 0;
		}
	}
	$dsinfo{$dsname}{colour} =(shift @colours);
	$dsinfo{$dsname}{value}= -1;
	$dsinfo{$dsname}{pc} = 0.0 ;
	$max = $defmax;
	$max = shift @max if($#max>-1);
	$max = getmaxval($dsname) if(!$max);
	if( !$max ) {
		errormessage("No maximum value for '$dsname'");
		exit 0;
	}
	$dsinfo{$dsname}{max} = $max;
}
#errormessage("$ds[1]:$dsinfo{$ds[1]}{line}:$dsinfo{$ds[1]}{stack}:$dsinfo{$ds[1]}{colour}:$dsinfo{$ds[1]}{max}.");

# do the business
fetchdata();
makegraphic();

exit 0;
