File Coverage

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             print
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