| mmm documentation | Contained in the mmm distribution. |
MMM::Report::Html
use MMM::Report::Html;
my $mmm = MMM::Report::Html->new( configfile => $file );
$mmm->run();
Produce html report of MMM work done.
MMM MMM::Report MMM::Console
Olivier Thauvin <nanardon@nanardon.zarb.org>
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.
| mmm documentation | Contained in the mmm distribution. |
package MMM::Report::Html; use strict; use MMM; use base qw(MMM::Report); use CGI; use MMM::Utils;
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;