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 |