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