index: move $params declaration to lsort()
[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 @reps or fail 'No data in $fatedir';
55
56 $allpass = 100 * $allpass / @reps;
57 $allfail = 100 * $allfail / @reps;
58 my $warn = 100 - $allpass - $allfail;
59
60 my @sort = ('subarch', 'os', 'cc', 'comment', 'slot');
61 my $sort = param('asort') || param('dsort');
62 my $sdir = param('dsort') ? -1 : 1;
63 defined $sort and unshift @sort, $sort eq 'arch'? 'subarch': $sort;
64 $sort ||= $sort[0];
65
66 sub nscmp {
67     my ($a, $b) = @_;
68     return int $a || int $b ? $a <=> $b : lc $a cmp lc $b;
69 }
70
71 sub repcmp {
72     my $r;
73     for my $s (@sort) {
74         last if $r = $sdir * nscmp $$a{$s}, $$b{$s};
75     }
76     return $r;
77 };
78
79 (my $uri = $ENV{REQUEST_URI}) =~ s/\?.*//;
80 sub lsort {
81     my $params = join '&', map param($_), grep $_ !~ 'sort', param;
82     $params .= '&' if $params;
83     my ($text, $key, $p) = @_;
84     if ($sort eq $key) {
85         $p = param('asort') ? 'dsort' : 'asort';
86     }
87     if (!$p) {
88         $p = 'asort';
89     }
90     anchor $text, href => "$uri?$params$p=$key";
91 }
92
93 print "Content-type: text/html\r\n";
94
95 if ($ENV{HTTP_ACCEPT_ENCODING} =~ /gzip/) {
96     print "Content-Encoding: gzip\r\n\r\n";
97     open STDOUT, '|-', 'gzip';
98 } else {
99     print "\r\n";
100 }
101
102 doctype;
103 start 'html', xmlns => "http://www.w3.org/1999/xhtml";
104 start 'head';
105 tag 'meta', 'http-equiv' => "Content-Type",
106             'content'    => "text/html; charset=utf-8";
107 tag 'link', rel  => 'stylesheet',
108             type => 'text/css',
109             href => '//ffmpeg.org/default.css';
110 tag 'link', rel  => 'stylesheet',
111             type => 'text/css',
112             href => '/fate.css';
113 print "<title>FATE</title>\n";
114 print <<EOF;
115 <script type="text/javascript">
116   function toggle(id, arr) {
117       var e = document.getElementById(id);
118       if (e.style.display == 'table-row') {
119           e.style.display = 'none';
120           arr.textContent = '\\u25b6'
121       } else {
122           e.style.display = 'table-row';
123           arr.textContent = '\\u25bc'
124       }
125   }
126 </script>
127 EOF
128 end 'head';
129
130 start 'body';
131 start 'div', id => 'container';
132
133 navbar;
134
135 start 'div', id => 'body';
136
137 h1 'FATE';
138
139 start 'table', id => 'index', class => 'replist';
140 start 'thead';
141 start 'tr';
142 start 'td', colspan => 10, id => 'failometer';
143 span '&nbsp;', class => 'pass', style => "width: ${allpass}%" if $allpass;
144 span '&nbsp;', class => 'warn', style => "width: ${warn}%"    if $warn;
145 span '&nbsp;', class => 'fail', style => "width: ${allfail}%" if $allfail;
146 end 'td';
147 end 'tr';
148 start 'tr';
149 start 'th'; lsort 'Time',     'date', 'dsort'; end 'th';
150 start 'th'; lsort 'Rev',      'rev';           end 'th';
151 start 'th'; lsort 'Arch',     'arch';          end 'th';
152 start 'th'; lsort 'OS',       'os';            end 'th';
153 start 'th'; lsort 'Compiler', 'cc';            end 'th';
154 start 'th'; lsort 'Comment',  'comment';       end 'th';
155 start 'th', colspan => 2; lsort 'Warnings', 'nwarn'; end 'th';
156 start 'th', colspan => 2; lsort 'Tests', 'npass'; end 'th';
157 end 'tr';
158 end 'thead';
159 start 'tbody';
160 for my $rep (sort repcmp @reps) {
161     my $ntest = $$rep{ntests};
162     my $npass = $$rep{npass};
163     my $time = parse_date $$rep{date};
164     my $age  = time - tz_local_offset() - $time;
165     my $agestr = agestr $age, $time;
166     my $ageclass = '';
167     my $rtext;
168     my $rclass;
169     my $log;
170     my $alert = ('rejoice', '', 'alert')[$$rep{alert} + 1];
171     my $walert = ('rejoice', '', 'alert')[$$rep{dwarn} + 1];
172     (my $slotid = $$rep{slot}) =~ s/[^a-z0-9_-]/_/ig;
173
174     if ($age < $recent_age) {
175         $ageclass = 'recent';
176     } elsif ($age > $ancient_age) {
177         $ageclass = 'ancient';
178         $alert = '';
179     }
180
181     start 'tr', class => "$ageclass $alert alt hilight";
182     start 'td';
183     anchor $agestr, href => href slot => $$rep{slot};
184     end 'td';
185     if ($gitweb and $$rep{rev} =~ /(N-)?(.*)/) {
186         start 'td';
187         anchor $$rep{rev}, href => "$gitweb;a=commit;h=$2";
188         end 'td';
189     } else {
190         td $$rep{rev};
191     }
192     td $$rep{subarch};
193     td $$rep{os};
194     td $$rep{cc};
195     td $$rep{comment}, class => 'comment';
196     if ($npass) {
197         $rtext  = "$npass / $ntest";
198         $rclass = $npass==$ntest? 'pass' : $npass? 'warn' : 'fail';
199     } elsif (!$ntest and !$$rep{status}) {
200         $rtext  = "build only";
201         $rclass = $$rep{status}? 'fail' : 'pass';
202     } else {
203         $rtext  = $$rep{errstr};
204         $rclass = 'fail';
205         for my $base ('test', 'compile', 'configure') {
206             my $file = "$fatedir/$$rep{slot}/$$rep{date}/$base.log.gz";
207             if (-r $file) {
208                 $log = qx{zcat $file | tail -n20};
209                 last;
210             }
211         }
212     }
213     start 'td', class => 'warnleft';
214     anchor $$rep{nwarn}, class => $walert,
215       href => href slot => $$rep{slot}, time => $$rep{date}, log => 'compile';
216     end;
217     start 'td', class => 'warnright';
218     anchor '±', class => $walert,
219       href => href slot => $$rep{slot}, time => $$rep{date},
220         log => "compile/$$rep{pdate}";
221     end;
222     start 'td', class => "$rclass resleft";
223     anchor $rtext, href => href slot => $$rep{slot}, time => $$rep{date};
224     end 'td';
225     start 'td', class => "$rclass resright";
226     if ($npass < $ntest or $log) {
227         span '&#9654;', class => 'toggle', onclick => "toggle('$slotid', this)";
228     }
229     end 'td';
230     end 'tr';
231     print "\n";
232     if ($npass < $ntest && $ntest - $npass < 100) {
233         my $report = load_report $$rep{slot}, $$rep{date};
234         my @fail = grep $$_{status} ne '0', @{$$report{recs}};
235         my $nfail = @fail;
236         my $lastpass = load_lastpass $$rep{slot};
237
238         start 'tr', id => $slotid, class => 'slotfail';
239         start 'td', colspan => 10;
240         start 'table', class => 'minirep';
241         start 'thead';
242         start 'tr';
243         if ($nfail eq 1) {
244             th "$nfail failed test";
245         } else {
246             th "$nfail failed tests";
247         }
248         th 'Status', class => 'errcode';
249         end 'tr';
250         end 'thead';
251         start 'tbody';
252         for (sort { $$a{name} cmp $$b{name} } @fail) {
253             my $falert = $$rep{pdate} eq $$lastpass{$$_{name}}{date} ?
254               'alert' : '';
255             start 'tr', class => "alt hilight $falert";
256             td $$_{name};
257             td $$_{status}, class => 'errcode';
258             end 'tr';
259         }
260         end 'tbody';
261         end 'table';
262         end 'td';
263         end 'tr';
264         print "\n";
265         trowa { style => 'display: none' }, '';
266     } elsif ($log) {
267         start 'tr', id => $slotid, class => 'slotfail';
268         start 'td', colspan => 10;
269         start 'pre', class => 'minilog';
270         print encode_entities($log, '<>&"');
271         end 'pre';
272         end 'td';
273         end 'tr';
274         trowa { style => 'display: none' }, '';
275     }
276 }
277 end 'tbody';
278 end 'table';
279 end 'div';
280 end 'div';
281 end 'body';
282 end 'html';