fateserver: use singular form of "test" when applicable
[fateserver.git] / index.cgi
1 #! /usr/bin/perl
2 #
3 # Copyright (c) 2011 Mans Rullgard <mans@mansr.com>
4 #
5 # Permission to use, copy, modify, and distribute this software for any
6 # purpose with or without fee is hereby granted, provided that the above
7 # copyright notice and this permission notice appear in all copies.
8 #
9 # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHORS DISCLAIM ALL WARRANTIES
10 # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
11 # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR
12 # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
13 # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
14 # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
15 # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
16
17 use strict;
18 use warnings;
19
20 use CGI qw/param/;
21 use HTML::Entities;
22 use FATE;
23 use Time::Zone;
24
25 opendir D, $fatedir or fail 'Server error: $fatedir not found';
26 my @slots = grep /^[^.]/, readdir D;
27 closedir D;
28
29 my @reps;
30 my $allpass = 0;
31 my $allfail = 0;
32
33 for my $slot (@slots) {
34     next if -e "$fatedir/$slot/hidden";
35     my $rep = load_summary $slot, 'latest' or next;
36     next if time - parse_date($$rep{date}) > $hidden_age;
37     $$rep{subarch} = $$rep{arch} if not $$rep{subarch};
38     push @reps, $rep;
39     if ($$rep{npass} == $$rep{ntests} and !$$rep{status}) {
40         $allpass++;
41     } elsif ($$rep{npass} == 0) {
42         $allfail++;
43     }
44
45     if (my $prev = load_summary $slot, 'previous') {
46         my $nfail = $$rep{ntests}  - $$rep{npass};
47         my $pfail = $$prev{ntests} - $$prev{npass};
48         $$rep{alert} = $$rep{ntests} && $nfail <=> $pfail;
49         $$rep{dwarn} = $$rep{nwarn} <=> $$prev{nwarn};
50         $$rep{pdate} = $$prev{date};
51     }
52 }
53
54 $allpass = 100 * $allpass / @reps;
55 $allfail = 100 * $allfail / @reps;
56 my $warn = 100 - $allpass - $allfail;
57
58 my @sort = ('subarch', 'os', 'cc', 'comment', 'slot');
59 my $sort = param('asort') || param('dsort');
60 my $sdir = param('dsort') ? -1 : 1;
61 defined $sort and unshift @sort, $sort eq 'arch'? 'subarch': $sort;
62 $sort ||= $sort[0];
63
64 sub nscmp {
65     my ($a, $b) = @_;
66     return int $a || int $b ? $a <=> $b : lc $a cmp lc $b;
67 }
68
69 sub repcmp {
70     my $r;
71     for my $s (@sort) {
72         last if $r = $sdir * nscmp $$a{$s}, $$b{$s};
73     }
74     return $r;
75 };
76
77 (my $uri = $ENV{REQUEST_URI}) =~ s/\?.*//;
78 my $params = join '&', map param($_), grep $_ !~ 'sort', param;
79 $params .= '&' if $params;
80
81 sub lsort {
82     my ($text, $key, $p) = @_;
83     if ($sort eq $key) {
84         $p = param('asort') ? 'dsort' : 'asort';
85     }
86     if (!$p) {
87         $p = 'asort';
88     }
89     anchor $text, href => "$uri?$params$p=$key";
90 }
91
92 print "Content-type: text/html\r\n";
93
94 if ($ENV{HTTP_ACCEPT_ENCODING} =~ /gzip/) {
95     print "Content-Encoding: gzip\r\n\r\n";
96     open STDOUT, '|-', 'gzip';
97 } else {
98     print "\r\n";
99 }
100
101 doctype;
102 start 'html', xmlns => "http://www.w3.org/1999/xhtml";
103 start 'head';
104 tag 'meta', 'http-equiv' => "Content-Type",
105             'content'    => "text/html; charset=utf-8";
106 tag 'link', rel  => 'stylesheet',
107             type => 'text/css',
108             href => '//ffmpeg.org/default.css';
109 tag 'link', rel  => 'stylesheet',
110             type => 'text/css',
111             href => '/fate.css';
112 print "<title>FATE</title>\n";
113 print <<EOF;
114 <script type="text/javascript">
115   function toggle(id, arr) {
116       var e = document.getElementById(id);
117       if (e.style.display == 'table-row') {
118           e.style.display = 'none';
119           arr.textContent = '\\u25b6'
120       } else {
121           e.style.display = 'table-row';
122           arr.textContent = '\\u25bc'
123       }
124   }
125 </script>
126 EOF
127 end 'head';
128
129 start 'body';
130 start 'div', id => 'container';
131
132 navbar;
133
134 start 'div', id => 'body';
135
136 h1 'FATE';
137
138 start 'table', id => 'index', class => 'replist';
139 start 'thead';
140 start 'tr';
141 start 'td', colspan => 10, id => 'failometer';
142 span '&nbsp;', class => 'pass', style => "width: ${allpass}%" if $allpass;
143 span '&nbsp;', class => 'warn', style => "width: ${warn}%"    if $warn;
144 span '&nbsp;', class => 'fail', style => "width: ${allfail}%" if $allfail;
145 end 'td';
146 end 'tr';
147 start 'tr';
148 start 'th'; lsort 'Time',     'date', 'dsort'; end 'th';
149 start 'th'; lsort 'Rev',      'rev';           end 'th';
150 start 'th'; lsort 'Arch',     'arch';          end 'th';
151 start 'th'; lsort 'OS',       'os';            end 'th';
152 start 'th'; lsort 'Compiler', 'cc';            end 'th';
153 start 'th'; lsort 'Comment',  'comment';       end 'th';
154 start 'th', colspan => 2; lsort 'Warnings', 'nwarn'; end 'th';
155 start 'th', colspan => 2; lsort 'Tests', 'npass'; end 'th';
156 end 'tr';
157 end 'thead';
158 start 'tbody';
159 for my $rep (sort repcmp @reps) {
160     my $ntest = $$rep{ntests};
161     my $npass = $$rep{npass};
162     my $time = parse_date $$rep{date};
163     my $age  = time - tz_local_offset() - $time;
164     my $agestr = agestr $age, $time;
165     my $ageclass = '';
166     my $rtext;
167     my $rclass;
168     my $log;
169     my $alert = ('rejoice', '', 'alert')[$$rep{alert} + 1];
170     my $walert = ('rejoice', '', 'alert')[$$rep{dwarn} + 1];
171     (my $slotid = $$rep{slot}) =~ s/[^a-z0-9_-]/_/ig;
172
173     if ($age < $recent_age) {
174         $ageclass = 'recent';
175     } elsif ($age > $ancient_age) {
176         $ageclass = 'ancient';
177         $alert = '';
178     }
179
180     start 'tr', class => "$ageclass $alert alt hilight";
181     start 'td';
182     anchor $agestr, href => href slot => $$rep{slot};
183     end 'td';
184     if ($gitweb and $$rep{rev} =~ /(git-)?(.*)/) {
185         start 'td';
186         anchor $$rep{rev}, href => "$gitweb;a=commit;h=$2";
187         end 'td';
188     } else {
189         td $$rep{rev};
190     }
191     td $$rep{subarch};
192     td $$rep{os};
193     td $$rep{cc};
194     td $$rep{comment}, class => 'comment';
195     if ($npass) {
196         $rtext  = "$npass / $ntest";
197         $rclass = $npass==$ntest? 'pass' : $npass? 'warn' : 'fail';
198     } elsif (!$ntest and !$$rep{status}) {
199         $rtext  = "build only";
200         $rclass = $$rep{status}? 'fail' : 'pass';
201     } else {
202         $rtext  = $$rep{errstr};
203         $rclass = 'fail';
204         for my $base ('test', 'compile', 'configure') {
205             my $file = "$fatedir/$$rep{slot}/$$rep{date}/$base.log.gz";
206             if (-r $file) {
207                 $log = qx{zcat $file | tail -n20};
208                 last;
209             }
210         }
211     }
212     start 'td', class => 'warnleft';
213     anchor $$rep{nwarn}, class => $walert,
214       href => href slot => $$rep{slot}, time => $$rep{date}, log => 'compile';
215     end;
216     start 'td', class => 'warnright';
217     anchor '±', class => $walert,
218       href => href slot => $$rep{slot}, time => $$rep{date},
219         log => "compile/$$rep{pdate}";
220     end;
221     start 'td', class => "$rclass resleft";
222     anchor $rtext, href => href slot => $$rep{slot}, time => $$rep{date};
223     end 'td';
224     start 'td', class => "$rclass resright";
225     if ($npass < $ntest or $log) {
226         span '&#9654;', class => 'toggle', onclick => "toggle('$slotid', this)";
227     }
228     end 'td';
229     end 'tr';
230     print "\n";
231     if ($npass < $ntest && $ntest - $npass < 100) {
232         my $report = load_report $$rep{slot}, $$rep{date};
233         my @fail = grep $$_{status} ne '0', @{$$report{recs}};
234         my $nfail = @fail;
235         my $lastpass = load_lastpass $$rep{slot};
236
237         start 'tr', id => $slotid, class => 'slotfail';
238         start 'td', colspan => 10;
239         start 'table', class => 'minirep';
240         start 'thead';
241         start 'tr';
242         if ($nfail eq 1) {
243             th "$nfail failed test";
244         } else {
245             th "$nfail failed tests";
246         }
247         th 'Status', class => 'errcode';
248         end 'tr';
249         end 'thead';
250         start 'tbody';
251         for (sort { $$a{name} cmp $$b{name} } @fail) {
252             my $falert = $$rep{pdate} eq $$lastpass{$$_{name}}{date} ?
253               'alert' : '';
254             start 'tr', class => "alt hilight $falert";
255             td $$_{name};
256             td $$_{status}, class => 'errcode';
257             end 'tr';
258         }
259         end 'tbody';
260         end 'table';
261         end 'td';
262         end 'tr';
263         print "\n";
264         trowa { style => 'display: none' }, '';
265     } elsif ($log) {
266         start 'tr', id => $slotid, class => 'slotfail';
267         start 'td', colspan => 10;
268         start 'pre', class => 'minilog';
269         print encode_entities($log, '<>&"');
270         end 'pre';
271         end 'td';
272         end 'tr';
273         trowa { style => 'display: none' }, '';
274     }
275 }
276 end 'tbody';
277 end 'table';
278 end 'div';
279 end 'div';
280 end 'body';
281 end 'html';