| blib/lib/MMM/Report/Html.pm | |||
|---|---|---|---|
| Criterion | Covered | Total | % |
| statement | 15 | 83 | 18.0 |
| branch | 0 | 58 | 0.0 |
| condition | 0 | 12 | 0.0 |
| subroutine | 5 | 9 | 55.5 |
| pod | 4 | 4 | 100.0 |
| total | 24 | 166 | 14.4 |
| line | stmt | bran | cond | sub | pod | time | code |
|---|---|---|---|---|---|---|---|
| 1 | package MMM::Report::Html; | ||||||
| 2 | |||||||
| 3 | 2 | 2 | 3563 | use strict; | |||
| 2 | 6 | ||||||
| 2 | 736 | ||||||
| 4 | 2 | 2 | 548 | use MMM; | |||
| 2 | 8 | ||||||
| 2 | 65 | ||||||
| 5 | 2 | 2 | 17 | use base qw(MMM::Report); | |||
| 2 | 6 | ||||||
| 2 | 1008 | ||||||
| 6 | 2 | 2 | 9128 | use CGI; | |||
| 2 | 64930 | ||||||
| 2 | 20 | ||||||
| 7 | 2 | 2 | 320 | use MMM::Utils; | |||
| 2 | 5 | ||||||
| 2 | 5811 | ||||||
| 8 | |||||||
| 9 | =head1 NAME | ||||||
| 10 | |||||||
| 11 | MMM::Report::Html | ||||||
| 12 | |||||||
| 13 | =head1 SYNOPSIS | ||||||
| 14 | |||||||
| 15 | use MMM::Report::Html; | ||||||
| 16 | my $mmm = MMM::Report::Html->new( configfile => $file ); | ||||||
| 17 | $mmm->run(); | ||||||
| 18 | |||||||
| 19 | =head1 DESCRIPTION | ||||||
| 20 | |||||||
| 21 | Produce html report of MMM work done. | ||||||
| 22 | |||||||
| 23 | =head1 SEE ALSO | ||||||
| 24 | |||||||
| 25 | L |
||||||
| 26 | L |
||||||
| 27 | L |
||||||
| 28 | |||||||
| 29 | =cut | ||||||
| 30 | |||||||
| 31 | sub new { | ||||||
| 32 | 0 | 0 | 1 | my ( $class, @args ) = @_; | |||
| 33 | 0 | 0 | my $me = $class->SUPER::new(@args) or return; | ||||
| 34 | 0 | $me->{cgi} = new CGI; | |||||
| 35 | 0 | bless( $me, $class ); | |||||
| 36 | 0 | $me->load; | |||||
| 37 | 0 | $me | |||||
| 38 | } | ||||||
| 39 | |||||||
| 40 | sub header { | ||||||
| 41 | 0 | 0 | 1 | my ($self) = @_; | |||
| 42 | 0 | print $self->{cgi}->start_html( | |||||
| 43 | -title => 'MMM report page', | ||||||
| 44 | -style => { -verbatim => < | ||||||
| 45 | |||||||
| 46 | h3 { | ||||||
| 47 | border-left-style : solid; | ||||||
| 48 | border-left-width : 8px; | ||||||
| 49 | padding-left : 6px; | ||||||
| 50 | } | ||||||
| 51 | |||||||
| 52 | .ok { | ||||||
| 53 | border-left-color : #24941a; | ||||||
| 54 | } | ||||||
| 55 | |||||||
| 56 | .err { | ||||||
| 57 | border-left-color : #d7282b; | ||||||
| 58 | } | ||||||
| 59 | |||||||
| 60 | .warn { | ||||||
| 61 | border-left-color : #f1920c; | ||||||
| 62 | } | ||||||
| 63 | |||||||
| 64 | pre { | ||||||
| 65 | background-color : #ffd894; | ||||||
| 66 | overflow : scroll; | ||||||
| 67 | } | ||||||
| 68 | |||||||
| 69 | EOF | ||||||
| 70 | ), | ||||||
| 71 | $self->{cgi}->h1( { align => 'center' }, 'MMM report page' ), "\n"; | ||||||
| 72 | } | ||||||
| 73 | |||||||
| 74 | sub footer { | ||||||
| 75 | 0 | 0 | 1 | my ($self) = @_; | |||
| 76 | |||||||
| 77 | 0 | my %loc = (); | |||||
| 78 | 0 | 0 | foreach my $item (@{ $self->{tasks} || [] }) { | ||||
| 0 | |||||||
| 79 | 0 | my $task = $item->[0]; | |||||
| 80 | 0 | 0 | my %info = %{ $item->[1] || {} }; | ||||
| 0 | |||||||
| 81 | 0 | 0 | if ($info{success}{url}) { | ||||
| 82 | 0 | 0 | my $m = MMM::Mirror->new(url => $info{success}{url}) | ||||
| 83 | or next; | ||||||
| 84 | 0 | 0 | my $h = $self->{mirrorlist}->find_host($m->hostinfo) | ||||
| 85 | or next; | ||||||
| 86 | 0 | my ($lat, $long) = $h->geo; | |||||
| 87 | 0 | 0 | 0 | if (defined($lat) && defined($long)) { | |||
| 88 | 0 | push (@{ $loc{$lat}{$long} }, $task->name); | |||||
| 0 | |||||||
| 89 | } | ||||||
| 90 | } | ||||||
| 91 | } | ||||||
| 92 | |||||||
| 93 | 0 | 0 | if (keys %loc) { | ||||
| 94 | 0 | my (@string, @mlist); | |||||
| 95 | 0 | my $num = 0; | |||||
| 96 | 0 | foreach my $lat (sort { $b <=> $a } keys %loc) { | |||||
| 0 | |||||||
| 97 | 0 | foreach my $long (sort { $b <=> $a } keys %{ $loc{$lat} }) { | |||||
| 0 | |||||||
| 0 | |||||||
| 98 | 0 | push(@string, sprintf("name=%d;lat=%s;long=%s", ++$num, | |||||
| 99 | $lat, $long)); | ||||||
| 100 | 0 | push(@mlist, sprintf("%d, %d: %s", $lat, $long, join(", ", @{ $loc{$lat}{$long} }))); | |||||
| 0 | |||||||
| 101 | } | ||||||
| 102 | } | ||||||
| 103 | { | ||||||
| 104 | 0 | my ($lat, $long) = $self->hostinfo()->geo; | |||||
| 0 | |||||||
| 105 | 0 | 0 | 0 | if (defined($lat) && defined($long)) { | |||
| 106 | 0 | push(@string, sprintf("name=%s;lat=%s;long=%s", | |||||
| 107 | 'Me', $lat, $long)); | ||||||
| 108 | } | ||||||
| 109 | } | ||||||
| 110 | |||||||
| 111 | |||||||
| 112 | 0 | 0 | ' ', "\n", |
||||
| 113 | $self->{cgi}->img({ | ||||||
| 114 | src => 'http://maps.fallingrain.com/perl/map.cgi?kind=topo;x=600;y=400;' . | ||||||
| 115 | join(';', @string), | ||||||
| 116 | } | ||||||
| 117 | ), "\n", | ||||||
| 118 | $self->{cgi}->p( | ||||||
| 119 | sprintf('I am %s (%s, %s)',$self->hostinfo()->hostname, | ||||||
| 120 | 0 | map { $_ || 'N/A' } $self->hostinfo()->geo, | |||||
| 121 | ) | ||||||
| 122 | ), "\n", | ||||||
| 123 | $self->{cgi}->ol({}, $self->{cgi}->li({}, [ @mlist ])), "\n"; | ||||||
| 124 | } | ||||||
| 125 | |||||||
| 126 | 0 | my $gtime = scalar( gmtime() ); | |||||
| 127 | 0 | print < | |||||
| 128 | |
||||||
| 129 | Generated by MMM $MMM::VERSION at $gtime |
||||||
| 130 | EOF | ||||||
| 131 | 0 | print $self->{cgi}->end_html(), "\n"; | |||||
| 132 | } | ||||||
| 133 | |||||||
| 134 | sub body_queue { | ||||||
| 135 | 0 | 0 | 1 | my ($self, $q, %info) = @_; | |||
| 136 | 0 | printf('', $q->name); | |||||
| 137 | 0 | 0 | print $self->{cgi} | ||||
| 0 | |||||||
| 0 | |||||||
| 0 | |||||||
| 138 | ->h3( | ||||||
| 139 | { | ||||||
| 140 | -class => $info{job}{is_running} | ||||||
| 141 | ? 'warn' | ||||||
| 142 | : $info{job}{success} | ||||||
| 143 | ? 'ok' | ||||||
| 144 | : $info{job}{start} | ||||||
| 145 | ? 'err' | ||||||
| 146 | : $info{job}{end} | ||||||
| 147 | ? 'err' | ||||||
| 148 | : 'warn', | ||||||
| 149 | }, | ||||||
| 150 | $q->name() | ||||||
| 151 | ), | ||||||
| 152 | "\n"; | ||||||
| 153 | |||||||
| 154 | 0 | 0 | if ( $q->val('announce') ) { | ||||
| 155 | 0 | printf( " %s \n", $q->val('announce') ); |
|||||
| 156 | } | ||||||
| 157 | |||||||
| 158 | 0 | print $self->{cgi}->start_ul(); | |||||
| 159 | 0 | 0 | if ( defined($info{job}{size}) ) { | ||||
| 160 | 0 | print $self->{cgi}->li( | |||||
| 161 | sprintf('Size is %dkB', $info{job}{size}) | ||||||
| 162 | ), "\n"; | ||||||
| 163 | } | ||||||
| 164 | 0 | 0 | print $self->{cgi}->li( | ||||
| 0 | |||||||
| 165 | $info{job}{is_running} | ||||||
| 166 | ? 'Is currently running for ' . fmt_duration(scalar(time), $info{job}{is_running} ) | ||||||
| 167 | : $info{job}{next_run_time} > scalar(time) | ||||||
| 168 | ? sprintf( 'Will be run in %s', fmt_duration(scalar(time), $q->next_run_time ) ) | ||||||
| 169 | : 'Is waiting next process' | ||||||
| 170 | ); | ||||||
| 171 | 0 | 0 | if ( $info{job}{start} ) { | ||||
| 172 | 0 | 0 | print $self->{cgi}->li( | ||||
| 0 | |||||||
| 0 | |||||||
| 173 | sprintf( | ||||||
| 174 | "Last run: %s at %s (took %s)\n", | ||||||
| 175 | $info{job}{success} | ||||||
| 176 | ? 'Successed ' . | ||||||
| 177 | ($info{success}{url} | ||||||
| 178 | ? "from $info{success}{url}" | ||||||
| 179 | : $info{success}{sync_from} | ||||||
| 180 | ? "from $info{success}{sync_from}" | ||||||
| 181 | : '' | ||||||
| 182 | ) | ||||||
| 183 | : 'Failed', | ||||||
| 184 | scalar( gmtime( $info{job}{end} ) ), | ||||||
| 185 | fmt_duration($info{job}{start}, $info{job}{end}) , | ||||||
| 186 | ) | ||||||
| 187 | ); | ||||||
| 188 | 0 | 0 | if ( ! $info{job}{success} ) { | ||||
| 189 | 0 | 0 | print $self->{cgi}->li( | ||||
| 190 | sprintf( "last success end at %s", | ||||||
| 191 | scalar( gmtime( $info{success}{end} ) ) ) | ||||||
| 192 | ), "\n" if($info{success}{end}); | ||||||
| 193 | 0 | 0 | 0 | print $self->{cgi}->li(sprintf( | |||
| 0 | |||||||
| 194 | "it is failing for %s", fmt_duration( | ||||||
| 195 | $info{success}{end} || $info{success}{first_sync}, scalar(time) | ||||||
| 196 | ) | ||||||
| 197 | ) | ||||||
| 198 | ), "\n" if($info{success}{end} || $info{success}{first_sync}); | ||||||
| 199 | } | ||||||
| 200 | 0 | print $self->{cgi}->end_ul(); | |||||
| 201 | 0 | 0 | if (!$info{job}{success}) { | ||||
| 202 | 0 | 0 | if (@{ $info{job}{error_log} || [] }) { | ||||
| 0 | 0 | ||||||
| 203 | 0 | print "\n"; |
|||||
| 204 | 0 | 0 | print map { "$_\n" } @{ $info{job}{error_log} || [] }; | ||||
| 0 | |||||||
| 0 | |||||||
| 205 | 0 | print "\n"; | |||||
| 206 | } | ||||||
| 207 | } | ||||||
| 208 | } | ||||||
| 209 | else { | ||||||
| 210 | 0 | print $self->{cgi}->li("Has been never run yet"); | |||||
| 211 | 0 | print $self->{cgi}->end_ul(); | |||||
| 212 | } | ||||||
| 213 | 0 | print " \n"; |
|||||
| 214 | } | ||||||
| 215 | |||||||
| 216 | 1; | ||||||
| 217 | |||||||
| 218 | =head1 AUTHOR | ||||||
| 219 | |||||||
| 220 | Olivier Thauvin |
||||||
| 221 | |||||||
| 222 | =head1 COPYRIGHT AND LICENSE | ||||||
| 223 | |||||||
| 224 | Copyright (C) 2006 Olivier Thauvin | ||||||
| 225 | |||||||
| 226 | This program is free software; you can redistribute it and/or | ||||||
| 227 | modify it under the terms of the GNU General Public License | ||||||
| 228 | as published by the Free Software Foundation; either version 2 | ||||||
| 229 | of the License, or (at your option) any later version. | ||||||
| 230 | |||||||
| 231 | This program is distributed in the hope that it will be useful, | ||||||
| 232 | but WITHOUT ANY WARRANTY; without even the implied warranty of | ||||||
| 233 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||||||
| 234 | GNU General Public License for more details. | ||||||
| 235 | |||||||
| 236 | You should have received a copy of the GNU General Public License | ||||||
| 237 | along with this program; if not, write to the Free Software | ||||||
| 238 | Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. | ||||||
| 239 | |||||||
| 240 | =cut |