#!/usr/bin/perl

use strict;
use warnings FATAL => 'all';

use CGI ':cgi-lib';
use Symbol;
use YATG::Config;
YATG::Config->Defaults->{'no_validation'} = 1;
use Config::Any;

use perlchartdir; # please do; it's very good.

# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

my $yatg_config_file = $ENV{YATG_CONFIG_FILE} || die "no yatg conf location";
my $yatg_conf = YATG::Config->parse($yatg_config_file)
    || die "failed to load yatg config $yatg_config_file";

perlchartdir::setLicenseCode($yatg_conf->{yatg}->{perlchartdir_key})
    if exists $yatg_conf->{yatg}->{perlchartdir_key};

my $yatg_graph_conf = $ENV{YATG_GRAPH_CONF} || die "missing yatg graph conf";
my $graph_conf = Config::Any->load_files(
    {files => [$yatg_graph_conf], use_ext => 1})->[0]->{$yatg_graph_conf}
    || die "failed to load yatg graph config $yatg_graph_conf";

# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

my $width = "700";
my $height = "290";

my %p = Vars;
map {s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg} values %p; # uri unescape

my ($period,$title,$ytitle,$ip,$port,$lf,$lftxt,$end)
    = @p{qw/period title ytitle ip port lf lftxt end/};

# FIXME params should be validated

my ($xtitle, $totaltime, $timefmt, $step, $major,
        $xlbloffset, $rulecols, $xtickcols)
    = @{ $graph_conf->{$period} };

$end = ($end - ($end % $step));
my $start = (($end - $totaltime) - (($end - $totaltime) % $major));

my @ports  = split "\0", $port;
my @legend = split "\0", $lftxt; # lib_cgi
my %leaves = map {$_ => shift @legend} split "\0", $lf;

my %colour;
@colour{keys %leaves} = ( 0x00990033, 0x003366cc );

# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

sub normalize_data {
    my $leaf = shift;
    my %input = @_;
    my $wrap32 = 2**32;
    my $wrap64 = 2**64;

    my $xdata = [sort {$a <=> $b} keys %input];
    my $data  = [map {$input{$_}} @$xdata];

    my $xdataary = ArrayMath->new($xdata)->delta;
    my $dataary  = ArrayMath->new($data)->delta;

    # fix missing points to zero
    for (reverse (1 .. $#{$data})) {
        $data->[$_] = 0
            if !defined $data->[$_]
            or !defined $data->[$_ - 1]
            or $data->[$_ - 1] eq 0;
    }

    # look for strange or wrapped data points
    while (1) {
        my $shifted = 0;
        for (1 .. $#{$data}) {
            if ($data->[$_] != 0
            and $data->[$_] < $data->[$_ - 1]) {

                $data->[$_] += ( $leaf =~ m/HC/ ? $wrap64 : $wrap32);
                    # broken, in so many ways. assumes a wrap but it could
                    # have been a reboot. assumes naming of leaves; and so on
                $shifted = 1;
            }
        }
        last if ! $shifted;
    }


    # now squish and scale the data
    $dataary->selectGTZ($data);
    $dataary->div($xdataary->result);
    $dataary->mul2(8);
    $dataary->div2(1048576);
    $dataary->selectNEZ([],$perlchartdir::NoValue);

    return ($dataary, $xdata);
}

# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

# Create an XYChart object with a light blue (EEEEFF)
# background, black border, 1 pixel border
my $c = new XYChart($width, $height, 0x00eeeeff, 0x00000000);

# Set the plotarea at (55, 48) and of size 520 x 195 pixels, with white background.
# Turn on both horizontal and vertical grid lines with light grey color (0x00cccccc)
$c->setPlotArea(55, 48, ($width - 80), ($height - 95), 0x00ffffff)->setGridColor(@$rulecols);

# Add a legend box at (50, 20) (top of the chart) with horizontal layout. Use 9 pts
# Arial Bold font. Set the background and border color to Transparent.
$c->addLegend(50, 20, 0, "arialbd.ttf", 9)->setBackground($perlchartdir::Transparent);

# Add a title box to the chart using 12 pts Times Bold Italic font, on a light
# blue (CCCCFF) background.
$c->addTitle($title, "timesbi.ttf", 12)->setBackground(0x00ccccff, 0x00000000);

$c->yAxis->setTitle($ytitle,"",9);
$c->xAxis->setTitle($xtitle,"",9);

$c->xAxis->setLabelFormat("{value|$timefmt}");
$c->xAxis->setLabelOffset($xlbloffset);
$c->xAxis->setTickColor(@$xtickcols);

# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

my ($minx, $maxx);

foreach my $leaf (keys %leaves) {

    my $mod = undef;
    $mod = 'RPC'
        if grep m/^rpc$/i,  @{$yatg_conf->{yatg}->{oids}->{$leaf}};
    $mod = 'Disk'
        if grep m/^disk$/i, @{$yatg_conf->{yatg}->{oids}->{$leaf}};
    defined $mod or die "Storage for $leaf is not RPC or Disk\n";

    eval "require YATG::Retrieve::$mod" or die $@;

    my @ret;
    foreach my $port (@ports) {
        (my $mport = $port) =~ s/[^A-Za-z0-9]/./g;

        my $tmp_ret =
            &{*{Symbol::qualify_to_ref('retrieve',"YATG::Retrieve::$mod")}}
                ({%$yatg_conf}, $ip, $mport, $leaf, $start, $end, $step);

        $#ret = $#{$tmp_ret};
        foreach (@ret) { $_ ||= 0; $_ += shift @$tmp_ret }
    }

    my $data;
    foreach my $offset (0 .. $#ret) {
        $data->{$start + ($offset * $step)} = $ret[$offset];
    }

    my ($dataary, $xdata);
    if (grep m/^ifindex$/, @{$yatg_conf->{yatg}->{oids}->{$leaf}}) { # hacky?
        ($dataary, $xdata) = normalize_data($leaf, %$data);
    }
    else {
        ($dataary, $xdata) =
            (ArrayMath->new(values %$data), ArrayMath->new(keys %$data));
    }

    $minx ||= $xdata->[0];
    $maxx ||= $xdata->[-1];

    my $layer =
        $c->addLineLayer($dataary->result, $colour{$leaf}, $leaves{$leaf});
    $layer->setXData( ArrayMath->new($xdata)->add(62135600400 - 3600)->result );
}

# fix unix epoch to perlchartdir epoch
$c->xAxis->setDateScale(
     62135600400 - 3600 + $minx,
     62135600400 - 3600 + $maxx,
     $major, $major / 3
);

# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

print "Content-type: image/png\n\n";
print $c->makeChart2($perlchartdir::PNG);

__END__

=head1 NAME

yatggraph.cgi - CGI to make PNG of YATG polled port traffic data

=head1 IMPORTANT NOTE

Do not place this script on a public or Internet-accessible web server!

It is a proof-of-concept, and contains no parameter checking whatsoever, so
your users can pass any old junk parameters in, and they will be assumed
valid. This could cause your web-server to be hacked.

The author and copyright holder take no responsibility whatsoever for any
damages incurred as a result of using this software.

=head1 DESCRIPTION

Please see the documentation for L<yatgview.cgi>.

=head1 ACKNOWLEDGEMENTS

This CGI is based upon the RTG CGIs by Anthony Tonns.

=head1 AUTHOR

Oliver Gorwits C<< <oliver.gorwits@oucs.ox.ac.uk> >>

=head1 COPYRIGHT & LICENSE

Copyright (c) The University of Oxford 2007.

This library is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.

=cut