#!/usr/bin/perl -T -w

use CGI::Carp qw(fatalsToBrowser carpout);
use Time::Local;
use File::Basename;
use FileHandle;
use POSIX;
use RRDs;

BEGIN {
	carpout(\*STDOUT);
};

use strict;

use vars qw($VERSION);
my $rcs = ' $Id: rrdview.cgi,v 1.1.1.1 2002/02/26 10:21:20 oetiker Exp $ ' ;
$rcs =~ m/,v (\d+\.\d+)/;
$VERSION = ($1) ? $1 : "UNKNOWN";

my $mod_perl = (exists $ENV{MOD_PERL}) ? 1 : 0;
my $self  = basename($0);
my $imgErr; # global is good in that huge case.

doit();

sub doit {
	
	my $debug = 0;
	my $cgi   = myCGI->new();
	my $q     = $cgi->r();
	my $now   = time();
	
	my $strftime = '%A %d %B %Y %H:%M:%S %Z';
	
	my ($minD,$hourD,$mdayD,$monD,$yearD) = (myLocaltime($now));
	$cgi->paramDefault(
			   'minE'  => $minD,
			   'hourE' => $hourD,
			   'mdayE' => $mdayD,
			   'monE'  => $monD,
			   'yearE' => $yearD,
			  );
	
	($minD,$hourD,$mdayD,$monD,$yearD) = (myLocaltime($now - 86400));
	
	$cgi->paramDefault(
			   'minS'  => $minD,
			   'hourS' => $hourD,
			   'mdayS' => $mdayD,
			   'monS'  => $monD,
			   'yearS' => $yearD,
			  );
	
	
	my ($minS,$hourS,$mdayS,$monS,$yearS) = 
	  (
	   $q->param(-Name => 'minS'),
	   $q->param('hourS'),
	   $q->param('mdayS'),
	   $q->param('monS'),
	   $q->param('yearS'),
	  );
	
	my ($minE,$hourE,$mdayE,$monE,$yearE) = 
	  (
	   $q->param('minE'),
	   $q->param('hourE'),
	   $q->param('mdayE'),
	   $q->param('monE'),
	   $q->param('yearE'),
	  );
	
	my $start = myTimelocal($minS,$hourS,$mdayS,$monS,$yearS);
	my $end   = myTimelocal($minE,$hourE,$mdayE,$monE,$yearE);
	
	my $startString = strftime($strftime, localtime($start));
	my $endString   = strftime($strftime, localtime($end));
	
	$q->param('start', $start);
	$q->param('end', $end);
	
	$cgi->paramDefault(
			   'hight'   => 150,
			   'width'   => 600,
			   'rrdfile' => 'foo.rrd',
			  );
	
	my $width = $q->param(-Name=>'width');
	my $hight = $q->param(-Name=>'hight');
	my $owner = $q->param(-Name=>'owner') || "No Owner";
	my $title = $q->param(-Name=>'title') || "No Title";
	
	my $rrdfile = $q->param("rrdfile");
	
	$debug and $cgi->saveparam("/tmp/rrdmon.out");
	my $error = "";
	my $rrdinfo;
	my @dsname;
	unless (-f $rrdfile) {
		$error = "<big>File '$rrdfile' does not exist!</big><BR>\n";
	}else{
		$rrdinfo = RRDs::info $rrdfile;
		if (my $ERR=RRDs::error) {
			$error = "<big>" . $ERR . "</big><BR>\n";
			@dsname = ('RRD ERROR');
		}else{
			foreach my $key (keys %$rrdinfo) {
				if ($key =~ m/ds\[(\w+)\]\.value/) {
					push(@dsname, $1);
				}
			}
		}
	};
	
	my $dsname  = $q->param("dsname") || $dsname[0] || "unknown";
	
	if (defined $q->param(-Name=>'child')) {
		# cgi child
		imagepage($q, 
			  $cgi, 
			  $debug, 
			  $rrdfile, 
			  $dsname,
			  $owner,
			  $hight,
			  $width,
			  $start,
			  $end,
			  $title,
			 );
	}else{
		# cgi parent
		mainpage($q, 
			 $cgi, 
			 $debug, 
		 $dsname, 
		 \@dsname, 
		 $hight, 
		 $width, 
		 $error,
		 $startString,
		 $endString,
		);
	}
}

sub mainpage {
	
	my $q = shift;
	my $cgi = shift;
	my $debug = shift;
	my $dsname = shift;
	my $ldsname = shift;
	my $hight = shift;
	my $width =  shift;
	my $error = shift;
	my $startString = shift;
	my $endString = shift;

	my $queryChild = "child=yes&".$q->query_string();
	my $cgiChild = myCGI->new($queryChild);
	# CGI fork ! 
	print 
	  $q->header(),
	  #$q->start_html($q->param('owner'). " " . $q->param('title') ),
	  $q->start_html(
			 -Title=>"RRDVIEW $VERSION",
			 -Author=>'lamiral@mail.dotcom.fr',
			 -Meta=>{'keywords'=>'monitoring rrdtool rrdmon rrdview',
				 'copyright'=>'Copyleft GPL'},
			 -BGCOLOR=>'lightblue',
			),
	    ($debug) ?                   "<tt>\n" : "",
	    ($debug and $mod_perl) ?     "mod_perl PID $$<BR>\n" : "",
	    ($debug and not $mod_perl) ? "PID=$$<BR>\n" : "",
	    ($debug) ?                   "$cgi<BR>\n" : "",
	    ($debug) ?                   "$q<BR>\n" : "",
	    ($debug) ?                   "img=".\$imgErr."<BR>\n" : "",
	    ($debug) ?                   "</tt>\n" : "",
	    $q->startform(-Method=>'GET',
			  #-Enctype=>'multipart/form-data',
			 ),
	    $q->textfield(-Name=>'rrdfile', 
			-Default=>'Give me a file like foo.rrd',
			-Size=>76),
	  $q->br(),"\n",
	  $q->popup_menu(-Name=>'dsname',
			 -Values=>[@$ldsname],
			 -Default=>$dsname,
		    ),
	  $q->textfield(-Name=>'hight', -Size=>length($hight)), "x",
	  $q->textfield(-Name=>'width', -Size=>length($width)), " ",
	  $q->br(),"\n",
	  $q->image_button(-Name=>'Beautiful Image!',
			   -Src=>"$self?$queryChild",
			  ),
	  $q->br(),"\n",
	  $error,
	  $q->tt(" From "),
	  $q->textfield(-Name=>'yearS', -Size=>4),
	  $q->textfield(-Name=>'monS',  -Size=>2),
	  $q->textfield(-Name=>'mdayS', -Size=>2),
	  " ",
	  $q->textfield(-Name=>'hourS', -Size=>2),
	  $q->textfield(-Name=>'minS',  -Size=>2),
	  " $startString",
	  $q->br(),"\n",
	  $q->tt(" To", "&nbsp;" x 2),
	  $q->textfield(-Name=>'yearE', -Size=>4),
	  $q->textfield(-Name=>'monE',  -Size=>2),
	  $q->textfield(-Name=>'mdayE', -Size=>2),
	  " ",
	  $q->textfield(-Name=>'hourE', -Size=>2),
	  $q->textfield(-Name=>'minE',  -Size=>2),
	  " $endString",
	  $q->br(),"\n",
	  $cgi->paramHidden(
			    'title',
			    'owner',
			   ),
  	    $q->endform(),
	    ($debug) ? $q->dump(): "",
	    $q->end_html(),
	    "\n",
	    ;
}


sub imagepage {

	my $q = shift;
	my $cgi = shift;
	my $debug = shift;
	my $rrdfile = shift;
	my $dsname = shift;
	my $owner  = shift;
	my $hight = shift;
	my $width = shift;
	my $start = shift;
	my $end = shift;
	my $title = shift;
	    
	$debug and $cgi->saveparam("/tmp/png.out");
	
	my $output;
	RRDs::last($rrdfile);
	
	print $q->header(
			 -Type=>'image/png',
			 -Expires=>'now'
			);
	
	if($mod_perl) {
                #carp("we're running under mod_perl");
		$output = "/tmp/rrdmon.img.$$.png";
		
	}
	else {
                #we're NOT running under mod_perl
		$output = "-";
		
	}

	RRDs::graph($output,"--title", "$owner",
		    "--imgformat", "PNG",
		    "--height","$hight", "--width","$width",
		    "--start",$start,"--end",$end,
		    "DEF:value=$rrdfile:$dsname:AVERAGE",
		    "AREA:value#00FF00:$title",
		   );
	
	
	if (my $ERROR = RRDs::error()) {
		carp "ERROR: $ERROR\n";
		my $rimgErr = loadImageErrorFromVar();
		print $$rimgErr;
		return();
	}
	if($mod_perl) {
		my $fh = FileHandle->new($output, "r");
		unless (defined($fh)){
			carp("Could not open ",$output,"$!");
			return undef;
		}
		local $/ = undef;
		my $file = <$fh>;
		$fh->close();
		print $file;
	}
}


sub myLocaltime {
	my $time = shift;

	my ($min,$hour,$mday,$mon,$year) 
	  = (localtime($time))[1,2,3,4,5];

	$min  = sprintf("%02s", $min);
	$hour = sprintf("%02s", $hour);
	$mday = sprintf("% 2s", $mday);
	$mon  = sprintf("% 2s", $mon + 1);
	
	return($min,$hour,$mday,$mon,$year + 1900);	
}

sub myTimelocal {
	my ($min,$hours,$mday,$mon,$year) = @_;
	
	my $time = timelocal(0,$min,$hours,$mday,
			     $mon - 1,$year - 1900);
	return($time);
}

sub loadImageErrorFromVar {
	unless (defined ($main::imgErr)){
		$main::imgErr = pack "h*", ' ';
	}
	return(\$main::imgErr);
}


package myCGI;

use CGI;

sub new {
	my $proto = shift;
	my $class = ref($proto) || $proto;
	my $self  = {};
	$self->{'CGI'} = CGI->new(shift);
	bless ($self, $class);
	return $self;
}

sub r {
	my $self = shift;
	return($self->{'CGI'});
}

sub DESTROY {
	my $self = shift;

}

sub paramDefault {
	my $self    = shift;
	my %param   = @_;
	
	foreach my $param (keys(%param)) {
		unless (defined($self->r->param(-Name=>$param))) {
			$self->r->param(-Name=>$param, -Value=>$param{$param});
		}
	}
	return values(%param);
}

sub paramHidden {
	my $self    = shift;
	my @hidden = @_;

	my @result;
	foreach my $param (@hidden) {
		push(@result, $self->r->hidden(-Name=>$param));
	}
	return(@result);
}

sub saveparam {
	my $self = shift;
	my $savefile = shift;
	my $fh = FileHandle->new($savefile, "w");
	defined($fh) || confess("Error opening $savefile (w): $!");
	$self->r->save($fh);
	$fh->close();
	chmod 0777, $savefile;
}


=head1 NAME

rrdview.cgi - Perl CGI software to graph rrd image online

=head1 SYNOPSIS

Put it on any cgi-bin/ directory, use a browser, click and fill in an
rrd file in the first textfield (replacing foo.rrd). The file belongs
to the web server. 

=head1 DESCRIPTION

Just another rrd viewer. 

=head1 TODO

 . An upload textfield to allow graphing client rrd files.
 . Deal with LAST, MAX, MIN RRA.

=head1 AUTHOR

Gilles LAMIRAL 
lamiral@mail.dotcom.fr

=head1 SEE ALSO

rrdtool(1), perl(1).

=cut



