fateserver: add FFmpeg website-style banner and navbar
[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 h1 'FATE';
135
136 start 'table', id => 'index', class => 'replist';
137 start 'thead';
138 start 'tr';
139 start 'td', colspan => 10, id => 'failometer';
140 span '&nbsp;', class => 'pass', style => "width: ${allpass}%" if $allpass;
141 span '&nbsp;', class => 'warn', style => "width: ${warn}%"    if $warn;
142 span '&nbsp;', class => 'fail', style => "width: ${allfail}%" if $allfail;
143 end 'td';
144 end 'tr';
145 start 'tr';
146 start 'th'; lsort 'Time',     'date', 'dsort'; end 'th';
147 start 'th'; lsort 'Rev',      'rev';           end 'th';
148 start 'th'; lsort 'Arch',     'arch';          end 'th';
149 start 'th'; lsort 'OS',       'os';            end 'th';
150 start 'th'; lsort 'Compiler', 'cc';            end 'th';
151 start 'th'; lsort 'Comment',  'comment';       end 'th';
152 start 'th', colspan => 2; lsort 'Warnings', 'nwarn'; end 'th';
153 start 'th', colspan => 2; lsort 'Tests', 'npass'; end 'th';
154 end 'tr';
155 end 'thead';
156 start 'tbody';
157 for my $rep (sort repcmp @reps) {
158     my $ntest = $$rep{ntests};
159     my $npass = $$rep{npass};
160     my $time = parse_date $$rep{date};
161     my $age  = time - tz_local_offset() - $time;
162     my $agestr = agestr $age, $time;
163     my $ageclass = '';
164     my $rtext;
165     my $rclass;
166     my $log;
167     my $alert = ('rejoice', '', 'alert')[$$rep{alert} + 1];
168     my $walert = ('rejoice', '', 'alert')[$$rep{dwarn} + 1];
169     (my $slotid = $$rep{slot}) =~ s/[^a-z0-9_-]/_/ig;
170
171     if ($age < $recent_age) {
172         $ageclass = 'recent';
173     } elsif ($age > $ancient_age) {
174         $ageclass = 'ancient';
175         $alert = '';
176     }
177
178     start 'tr', class => "$ageclass $alert alt hilight";
179     start 'td';
180     anchor $agestr, href => href slot => $$rep{slot};
181     end 'td';
182     if ($gitweb and $$rep{rev} =~ /(git-)?(.*)/) {
183         start 'td';
184         anchor $$rep{rev}, href => "$gitweb;a=commit;h=$2";
185         end 'td';
186     } else {
187         td $$rep{rev};
188     }
189     td $$rep{subarch};
190     td $$rep{os};
191     td $$rep{cc};
192     td $$rep{comment}, class => 'comment';
193     if ($npass) {
194         $rtext  = "$npass / $ntest";
195         $rclass = $npass==$ntest? 'pass' : $npass? 'warn' : 'fail';
196     } elsif (!$ntest and !$$rep{status}) {
197         $rtext  = "build only";
198         $rclass = $$rep{status}? 'fail' : 'pass';
199     } else {
200         $rtext  = $$rep{errstr};
201         $rclass = 'fail';
202         for my $base ('test', 'compile', 'configure') {
203             my $file = "$fatedir/$$rep{slot}/$$rep{date}/$base.log.gz";
204             if (-r $file) {
205                 $log = qx{zcat $file | tail -n20};
206                 last;
207             }
208         }
209     }
210     start 'td', class => 'warnleft';
211     anchor $$rep{nwarn}, class => $walert,
212       href => href slot => $$rep{slot}, time => $$rep{date}, log => 'compile';
213     end;
214     start 'td', class => 'warnright';
215     anchor '±', class => $walert,
216       href => href slot => $$rep{slot}, time => $$rep{date},
217         log => "compile/$$rep{pdate}";
218     end;
219     start 'td', class => "$rclass resleft";
220     anchor $rtext, href => href slot => $$rep{slot}, time => $$rep{date};
221     end 'td';
222     start 'td', class => "$rclass resright";
223     if ($npass < $ntest or $log) {
224         span '&#9654;', class => 'toggle', onclick => "toggle('$slotid', this)";
225     }
226     end 'td';
227     end 'tr';
228     print "\n";
229     if ($npass < $ntest && $ntest - $npass < 100) {
230         my $report = load_report $$rep{slot}, $$rep{date};
231         my @fail = grep $$_{status} ne '0', @{$$report{recs}};
232         my $nfail = @fail;
233         my $lastpass = load_lastpass $$rep{slot};
234
235         start 'tr', id => $slotid, class => 'slotfail';
236         start 'td', colspan => 10;
237         start 'table', class => 'minirep';
238         start 'thead';
239         start 'tr';
240         th "$nfail failed tests";
241         th 'Status', class => 'errcode';
242         end 'tr';
243         end 'thead';
244         start 'tbody';
245         for (sort { $$a{name} cmp $$b{name} } @fail) {
246             my $falert = $$rep{pdate} eq $$lastpass{$$_{name}}{date} ?
247               'alert' : '';
248             start 'tr', class => "alt hilight $falert";
249             td $$_{name};
250             td $$_{status}, class => 'errcode';
251             end 'tr';
252         }
253         end 'tbody';
254         end 'table';
255         end 'td';
256         end 'tr';
257         print "\n";
258         trowa { style => 'display: none' }, '';
259     } elsif ($log) {
260         start 'tr', id => $slotid, class => 'slotfail';
261         start 'td', colspan => 10;
262         start 'pre', class => 'minilog';
263         print encode_entities($log, '<>&"');
264         end 'pre';
265         end 'td';
266         end 'tr';
267         trowa { style => 'display: none' }, '';
268     }
269 }
270 end 'tbody';
271 end 'table';
272 end 'div';
273 end 'body';
274 end 'html';