#!/usr/bin/perl -w
############################################################
#
#   $Id: rrd-browse.cgi 692 2006-06-26 19:11:14Z nicolaw $
#   rrd-browse.cgi - Graph browser CGI script for RRD::Simple
#
#   Copyright 2006,2007 Nicola Worthington
#
#   Licensed under the Apache License, Version 2.0 (the "License");
#   you may not use this file except in compliance with the License.
#   You may obtain a copy of the License at
#
#       http://www.apache.org/licenses/LICENSE-2.0
#
#   Unless required by applicable law or agreed to in writing, software
#   distributed under the License is distributed on an "AS IS" BASIS,
#   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
#   See the License for the specific language governing permissions and
#   limitations under the License.
#
############################################################
# vim:ts=4:sw=4:tw=78

# User defined constants
use constant BASEDIR => '/home/nicolaw/webroot/www/rrd.me.uk';
use constant RRDURL  => '';
use constant CACHE   => 1;

############################################################




use 5.8.0;
use warnings;
use strict;
use CGI;
use CGI::Carp qw(fatalsToBrowser);
use HTML::Template::Expr;
use File::Basename qw(basename);
use File::Spec::Functions qw(tmpdir catdir catfile);
use vars qw(%LIST_CACHE %GRAPH_CACHE);

use lib (BASEDIR.'/cgi-bin');
use RRDBrowseCommon qw(slurp by_domain alpha_period list_dir graph_def read_graph_data);

# Enable some basic caching
if (CACHE) {
	# Cache calls to list_dir() and graph_def()
	require Memoize;
	Memoize::memoize('list_dir',  LIST_CACHE   => [HASH => \%LIST_CACHE]);
	Memoize::memoize('graph_def', SCALAR_CACHE => [HASH => \%GRAPH_CACHE]);
}


# Grab CGI paramaters
my $cgi = new CGI;
my %q = $cgi->Vars;

# cd to the righr location and define directories
my %dir = map { ( $_ => BASEDIR."/$_" ) } qw(data etc graphs cgi-bin thumbnails);
chdir $dir{'cgi-bin'} || die sprintf("Unable to chdir to '%s': %s", $dir{'cgi-bin'}, $!);

# Create the initial %tmpl data hash
my %tmpl = %ENV;
$tmpl{template} = defined $q{template} && -f $q{template} ? $q{template} : 'export.tmpl';
$tmpl{title}    = ucfirst(basename($tmpl{template},'.tmpl')); $tmpl{title} =~ s/[_\-]/ /g;
$tmpl{self_url} = $cgi->self_url(-absolute => 1, -query_string => 0, -path_info => 0);
$tmpl{rrd_url}  = RRDURL;

# Generate and send an XLS document
if ($q{HOST} && $q{RRD}) {
	my $xls = '';
	eval { $xls = generate_xls(catfile($dir{data},$q{HOST},$q{RRD})); };

	if ($@ || !defined($xls) || !length($xls)) {
		$tmpl{error} = $@;
		$tmpl{template} = 'error.tmpl';

	} else {
		print $cgi->header(
				-type => 'application/vnd.ms-excel',
				-content_disposition => sprintf('attachment; filename=%s', 'filename.xls'),
				-content_length => length($xls),
				-cache_control => 'no-cache',
				-expires => '0',
			);
		print $xls;
		exit;
	}
}

# Go read a bunch of stuff from disk to pump in to %tmpl in a moment
my $gdefs = read_graph_data("$dir{etc}/graph.defs");
my @graphs = list_dir($dir{graphs});
my $tmpl_cache = { hosts => [], };
my $html = { last_update => 0, html => '' };

# Build the data
for my $host (sort by_domain list_dir($dir{data})) {
	next unless -d catfile($dir{data},$host);

	# NEECHI-HACK!
	next if defined($q{HOST}) && $q{HOST} ne $host;
	next if defined($q{LIKE}) && $tmpl{template} =~ /^by_host\.[^\.]+$/i && $host !~ /$q{LIKE}/i;

	(my $node = $host) =~ s/\..*//;
	(my $domain = $host) =~ s/^.*?\.//;
	(my $domain2 = $domain) =~ s/[^a-zA-Z0-9\_]/_/g;
	(my $host2 = $host) =~ s/[^a-zA-Z0-9\_]/_/g;

	my %host = (	node   => $node,
			host   => $host,	host2  => $host2,
			domain => $domain,	domain2 => $domain2,	);

	# Build a hash of potential files that users can slurp() or include
	# in their output template on a per host basis.
	for my $file (grep(/\.(?:te?xt|s?html?|xslt?|xml|css|tmpl)$/i,
			glob("$dir{data}/$host/include*.*"))) {
		(my $base = basename($file)) =~ s/\./_/g;
		$host{$base} = $file;
	}
		
	push @{$tmpl_cache->{hosts}}, \%host;
}

# Merge cache data in
$tmpl{hosts} = $tmpl_cache->{hosts};

# Render the output
if (exists $q{DEBUG} && $q{DEBUG} eq 'insecure') {
	require Data::Dumper;
	$tmpl{DEBUG} = Data::Dumper::Dumper(\%tmpl);
}
my $template = HTML::Template::Expr->new(
		filename            => $tmpl{template},
		associate           => $cgi,
		case_sensitive      => 1,
		loop_context_vars   => 1,
		max_includes        => 5,
		global_vars         => 1,
		die_on_bad_params   => 0,
		functions => {
			slurp => \&slurp,
			like => sub { return defined($_[0]) && defined($_[1]) && $_[0] =~ /$_[1]/i ? 1 : 0; },
			not => sub { !$_[0]; },
			equal_or_like => sub {
				return 1 if (!defined($_[1]) || !length($_[1])) && (!defined($_[2]) || !length($_[2]));
				#(warn "$_[0] eq $_[1]\n" && return 1) if defined $_[1] && "$_[0]" eq "$_[1]";
				(return 1) if defined $_[1] && "$_[0]" eq "$_[1]";
				return 1 if defined $_[2] && "$_[0]" =~ /$_[2]/;
				return 0;
			},
		},
	);
$template->param(\%tmpl);

$html->{html} = $template->output();
$html->{last_update} = time;
print $cgi->header(-content => 'text/html'), $html->{html};

exit;

1;


sub generate_xls {
	my $rrdfile = shift;
	return unless defined($rrdfile) && -f $rrdfile;

	require RRDs;
	require RRD::Simple;
	require Spreadsheet::WriteExcel;

	# Create an RRD object
	my $rrd = RRD::Simple->new(file => $rrdfile)
		|| die "Unable to instanciate RRD::Simple object for file '$rrdfile'";
	my @sources = $rrd->sources;
	my $info = $rrd->info;

	# Create a workbook
	open my $fh, '>', \my $xls or die "Failed to open filehandle: $!";
	my $workbook = Spreadsheet::WriteExcel->new($fh);

	my %labels = (
			'300-1'   => 'Daily',
			'300-6'   => 'Weekly',
			'300-24'  => 'Monthly',
			'300-288' => 'Annual',
		);

	# Create the overview worksheet
	my @sheet;
	OVERVIEW: {
		my $sheet = $workbook->add_worksheet('Summary');
		$sheet->set_zoom(80);
		$sheet->freeze_panes(1, 1);
		my ($row, $col) = (0, 0);

		my @fields = sort(keys(%{$info->{rra}->[0]}));
		$sheet->write_row($row, $col, [( '', @fields )] );

		for my $rra (@{$info->{rra}}) { $row++;
			my $label = sprintf('%s %s', 
				(exists $labels{"$info->{step}-$rra->{pdp_per_row}"} ? 
				$labels{"$info->{step}-$rra->{pdp_per_row}"} : rand(999) ),
				ucfirst(lc($rra->{cf})));
			$sheet->write_row($row, $col, [( $label, map { $rra->{$_} } @fields )] );
		}

		push @sheet, $sheet;
	}

	# Create the detail worksheets
	for my $rra (@{$info->{rra}}) {
		my $label = sprintf('%s %s', 
			(exists $labels{"$info->{step}-$rra->{pdp_per_row}"} ? 
			$labels{"$info->{step}-$rra->{pdp_per_row}"} : rand(999) ),
			ucfirst(lc($rra->{cf})));

		my $sheet = $workbook->add_worksheet($label);
		$sheet->set_zoom(80);
		$sheet->freeze_panes(1, 1);
		my ($row, $col) = (0, 0);

		my ($start,$step,$names,$data) = RRDs::fetch($rrdfile, $rra->{cf}, '-s', 60*60*24*365*10);
		$sheet->write_row($row, $col, [( '', @{$names} )] );
		for my $line (@{$data}) { $row++;
			$sheet->write_row($row, $col, [( '', @{$line} )] );
		}

#         my ($start,$step,$names,$data) = RRDs::fetch ...
#         print "Start:       ", scalar localtime($start), " ($start)\n";
#         print "Step size:   $step seconds\n";
#         print "DS names:    ", join (", ", @$names)."\n";
#         print "Data points: ", $#$data + 1, "\n";
#         print "Data:\n";
#         foreach my $line (@$data) {
#           print "  ", scalar localtime($start), " ($start) ";
#           $start += $step;
#           foreach my $val (@$line) {
#             printf "%12.1f ", $val;
#           }
#           print "\n";
#         }

		push @sheet, $sheet;
	}

	$workbook->close;
	return $xls;
}