The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Smolder::Control::Graphs;
use base 'Smolder::Control';
use strict;
use warnings;
use Smolder::Conf;
use Smolder::DB::Project;
use Smolder::DB::SmokeReport;
use DateTime;
use DateTime::Format::Strptime;
use File::Spec::Functions qw(catdir catfile);
use GD::Graph::area;
use GD::Graph::bars3d;
use GD::Graph::lines3d;
use GD::Graph::linespoints;
use GD::Text;
use HTML::FillInForm;

=head1 NAME

Smolder::Control::Graphs

=head1 DESCRIPTION

Controller module for generating graph images.

=cut

# allowable graph types
my %TYPE_MAP = (
    bar    => 'bars3d',
    line   => 'lines3d',
    area   => 'area',
    points => 'linespoints',
);

# corresponding color and legend for each data type
my %FIELDS = (
    total    => [qw(lblue Total)],
    pass     => [qw(green Pass)],
    fail     => [qw(red Fail)],
    todo     => [qw(lorange TODO)],
    skip     => [qw(lyellow Skip)],
    duration => [qw(lbrown Duration)],
);

sub setup {
    my $self = shift;
    $self->start_mode('start');
    $self->run_modes(
        [
            qw(
              start
              image
              )
        ]
    );
}

=head1 RUN MODES

=head2 start

Display the initial start form for a project's graph with some
reasonable defaults. Uses the F<Developer/Graphs/start.tmpl>
template.

=cut

sub start {
    my ($self, $tt_params) = @_;
    $tt_params ||= {};

    my $project = Smolder::DB::Project->retrieve($self->param('id'));
    return $self->error_message('Project does not exist')
      unless $project;

    # make sure ths developer is a member of this project
    return $self->error_message('Unauthorized for this project')
      unless $self->can_see_project($project);

    $tt_params->{project} = $project;

    # the defaults
    my %fill_data = (
        start => $project->graph_start_datetime->strftime(' %m/%d/%Y'),
        stop  => DateTime->today()->strftime('%m/%d/%Y'),
        pass  => 1,
        fail  => 1,
        type  => 'bar',
    );

    return HTML::FillInForm->new()->fill(
        scalarref => $self->tt_process($tt_params),
        fdat      => \%fill_data,
    );
}

=head2 image

Creates and returns a graph image to the browser based on the parameters
chosen by the user.

=cut

sub image {
    my $self  = shift;
    my $query = $self->query();

    my $project = Smolder::DB::Project->retrieve($self->param('id'));
    return $self->error_message('Project does not exist')
      unless $project;

    my ($start, $stop);
    my $dt_format = DateTime::Format::Strptime->new(pattern => '%m/%d/%Y',);
    if ($query->param('start')) {
        $start = $dt_format->parse_datetime($query->param('start'));
    } else {
        $start = $project->graph_start_datetime;
    }
    if ($query->param('stop')) {
        $stop = $dt_format->parse_datetime($query->param('stop'));
    } else {
        $stop = DateTime->today();
    }
    $self->log->debug("Graph starting $start and ending $stop");

    # which fields do we need to show?
    my @fields;
    if ($query->param('change')) {
        foreach my $field (keys %FIELDS) {
            push(@fields, $field) if ($query->param($field));
        }
    } else {

        # by default, show pass vs fail
        @fields = qw(pass fail);
    }

    my %search_params = (
        start => $start,
        stop  => $stop,
    );

    foreach my $extra_param (qw(tag architecture platform)) {
        $search_params{$extra_param} = $query->param($extra_param)
          if ($query->param($extra_param));
    }

    my $data = $project->report_graph_data(
        fields => \@fields,
        %search_params,
    );

    # send out our own headers
    # XXX - fix to use CGI.pm no Apache to send no-cache image/png headers'
    $self->header_type('none');

    # if we don't have any data, then just send the no_graph_data.png file
    if (scalar @$data == 0) {
        my $NO_DATA_FH;
        my $file = catfile(Smolder::Conf->get('HtdocsDir'), 'images', 'no_graph_data.png');
        open($NO_DATA_FH, '<', $file)
          or die "Could not open '$file' for reading: $!";
        local $/ = undef;
        print <$NO_DATA_FH>;
        close($NO_DATA_FH) or die "Could not close file '$file': $!";
    } else {

        # else create the graph and send it
        my @colors = map { $FIELDS{$_}->[0] } @fields;
        my @legend = map { $FIELDS{$_}->[1] } @fields;

        my $title = "'"
          . $project->name
          . "' Smoke Progress ("
          . $start->strftime('%m/%d/%Y') . ' - '
          . $stop->strftime('%m/%d/%Y') . ')';
        my $gd = $self->_create_progress_gd(
            colors => \@colors,
            data   => $data,
            legend => \@legend,
            title  => $title,
        );
        print $gd->png;
    }
}

sub _create_progress_gd {
    my ($self, %args) = @_;
    my $data   = $args{data};
    my $colors = $args{colors};
    my $legend = $args{legend};
    my $title  = $args{title};

    # what type of graph are we?
    my $type = $TYPE_MAP{$self->param('type')} || 'bars3d';

    # we just want to show the first, middle and last labels
    # on the X axis
    my $x_skip = int((scalar(@{$data->[0]}) - 1) / 2) + 1;

    # find the maximun value for the Y axis
    my $y_max = 0;
    for my $i (1 .. $#$data) {
        foreach my $point (@{$data->[$i]}) {
            $y_max = $point if ($point > $y_max);
        }
    }

    # now round up to the nearest 100
    $y_max = ($y_max + 100) - ($y_max % 100);

    my $class = 'GD::Graph::' . $type;
    my $graph = $class->new(600, 300);
    $graph->set(
        title                => $title,
        bgclr                => 'white',
        fgclr                => 'gray',
        textclr              => 'dgray',
        axislabelclr         => 'dgray',
        labelclr             => 'dgray',
        dclrs                => $colors,
        y_label              => '# of Tests',
        y_max_value          => $y_max,
        x_label_skip         => $x_skip,
        overwrite            => 1,
        legend_placement     => 'RT',
        legend_marker_width  => 20,
        legend_marker_height => 20,
        legend_spacing       => 8,
        x_labels_vertical    => 0,
    ) or die "Could not set graph attributes! - " . $graph->error();
    $graph->set_legend(@$legend);

    my $gd = $graph->plot($data)
      or die "Could not plot graph into GD object! - " . $graph->error();
    return $gd;
}

1;