The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package MMM::Report::Html;

use strict;
use MMM;
use base qw(MMM::Report);
use CGI;
use MMM::Utils;

=head1 NAME

MMM::Report::Html

=head1 SYNOPSIS

    use MMM::Report::Html;
    my $mmm = MMM::Report::Html->new( configfile => $file );
    $mmm->run();

=head1 DESCRIPTION

Produce html report of MMM work done.

=head1 SEE ALSO

L<MMM>
L<MMM::Report>
L<MMM::Console>

=cut

sub new {
    my ( $class, @args ) = @_;
    my $me = $class->SUPER::new(@args) or return;
    $me->{cgi} = new CGI;
    bless( $me, $class );
    $me->load;
    $me
}

sub header {
    my ($self) = @_;
    print $self->{cgi}->start_html(
        -title => 'MMM report page',
        -style => { -verbatim => <<EOF }

h3 {
    border-left-style : solid;
    border-left-width : 8px;
    padding-left      : 6px;
}

.ok {
    border-left-color : #24941a;
}

.err {
    border-left-color : #d7282b;
}

.warn {
    border-left-color : #f1920c;
}

pre {
    background-color : #ffd894;
    overflow : scroll;
}

EOF
    ),
      $self->{cgi}->h1( { align => 'center' }, 'MMM report page' ), "\n";
}

sub footer {
    my ($self) = @_;

    my %loc = ();
    foreach my $item (@{ $self->{tasks} || [] }) {
        my $task = $item->[0];
        my %info = %{ $item->[1] || {} };
        if ($info{success}{url}) {
            my $m = MMM::Mirror->new(url => $info{success}{url})
                or next;
            my $h = $self->{mirrorlist}->find_host($m->hostinfo)
                or next;
            my ($lat, $long) = $h->geo;
            if (defined($lat) && defined($long)) {
                push (@{ $loc{$lat}{$long}  }, $task->name);
            }
        }
    }

    if (keys %loc) {
        my (@string, @mlist);
        my $num = 0;
        foreach my $lat (sort { $b <=> $a } keys %loc) {
            foreach my $long (sort { $b <=> $a } keys %{ $loc{$lat} }) {
                push(@string, sprintf("name=%d;lat=%s;long=%s", ++$num,
                    $lat, $long));
                push(@mlist, sprintf("%d, %d: %s", $lat, $long, join(", ", @{ $loc{$lat}{$long} })));
            }
        }
        {
            my ($lat, $long) = $self->hostinfo()->geo;
            if (defined($lat) && defined($long)) {
                push(@string, sprintf("name=%s;lat=%s;long=%s",
                    'Me', $lat, $long));
            }
        }

        print
            '<hr width="20%" align="left">', "\n",
            $self->{cgi}->img({
                src => 'http://maps.fallingrain.com/perl/map.cgi?kind=topo;x=600;y=400;' . 
                    join(';', @string),
                }
            ), "\n",
            $self->{cgi}->p(
                sprintf('I am %s (%s, %s)',$self->hostinfo()->hostname,
                    map { $_ || 'N/A' } $self->hostinfo()->geo,
                )
            ), "\n",
            $self->{cgi}->ol({}, $self->{cgi}->li({}, [ @mlist ])), "\n";
    }

    my $gtime = scalar( gmtime() );
    print <<EOF;
<hr width="20%" align="left">
<p>Generated by <a href="http://mmm.zarb.org/">MMM $MMM::VERSION</a> at $gtime</p>
EOF
    print $self->{cgi}->end_html(), "\n";
}

sub body_queue {
    my ($self, $q, %info) = @_;
    printf('<a name="%s">', $q->name);
    print $self->{cgi}
      ->h3(
            {
              -class =>  $info{job}{is_running}
                ? 'warn'
                : $info{job}{success}
                  ? 'ok'
                  : $info{job}{start}
                    ? 'err'
                    : $info{job}{end}
                        ? 'err'
                        : 'warn',
            },
          $q->name()
      ),
      "</a>\n";

    if ( $q->val('announce') ) {
        printf( "<p>%s</p>\n", $q->val('announce') );
    }

    print $self->{cgi}->start_ul();
    if ( defined($info{job}{size}) ) {
        print $self->{cgi}->li(
            sprintf('Size is %dkB', $info{job}{size})
        ), "\n";
    }
    print $self->{cgi}->li(
        $info{job}{is_running}
        ? 'Is currently running for ' . fmt_duration(scalar(time), $info{job}{is_running} )
        : $info{job}{next_run_time} > scalar(time)
          ? sprintf( 'Will be run in %s', fmt_duration(scalar(time), $q->next_run_time ) )
          : 'Is waiting next process'
    );
    if ( $info{job}{start} ) {
        print $self->{cgi}->li(
            sprintf(
                "Last run: %s at %s (took %s)\n",
                $info{job}{success}
                    ? '<strong>Successed</strong> ' .
                    ($info{success}{url}
                        ? "from <strong>$info{success}{url}</strong>"
                        : $info{success}{sync_from}
                            ? "from <strong>$info{success}{sync_from}</strong>"
                            : ''
                    )
                    : '<strong>Failed</strong>',
                scalar( gmtime( $info{job}{end} ) ),
                fmt_duration($info{job}{start}, $info{job}{end}) ,
            )
        );
        if ( ! $info{job}{success} ) {
            print $self->{cgi}->li(
                sprintf( "last success end at %s",
                    scalar( gmtime( $info{success}{end} ) ) )
            ), "\n" if($info{success}{end});
            print $self->{cgi}->li(sprintf(
                    "it is failing for %s", fmt_duration(
                        $info{success}{end} || $info{success}{first_sync}, scalar(time)
                    )
                )
            ), "\n" if($info{success}{end} || $info{success}{first_sync});
        }
        print $self->{cgi}->end_ul();
        if (!$info{job}{success}) {
            if (@{ $info{job}{error_log} || [] }) {
                print "<pre>\n";
                print map { "$_\n" } @{ $info{job}{error_log} || [] };
                print "</pre>\n";
            }
        }
    }
    else {
        print $self->{cgi}->li("Has been never run yet");
        print $self->{cgi}->end_ul();
    }
    print "<br />\n";
}

1;

=head1 AUTHOR

Olivier Thauvin <nanardon@nanardon.zarb.org>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2006 Olivier Thauvin

This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.

=cut