Move revision to second column
[fateserver.git] / index.cgi
1 #! /usr/bin/perl
2
3 use strict;
4 use warnings;
5
6 use CGI qw/param/;
7 use HTML::Entities;
8 use FATE;
9
10 opendir D, $fatedir or fail 'Server error: $fatedir not found';
11 my @slots = grep /^[^.]/, readdir D;
12 closedir D;
13
14 my @reps;
15 my $allpass = 0;
16 my $allfail = 0;
17
18 for my $slot (@slots) {
19     next if -e "$fatedir/$slot/hidden";
20     my $rep = load_summary $slot, 'latest' or next;
21     next if time - parse_date($$rep{date}) > $hidden_age;
22     $$rep{subarch} = $$rep{arch} if not $$rep{subarch};
23     push @reps, $rep;
24     if ($$rep{npass} == 0) {
25         $allfail++;
26     } elsif ($$rep{npass} == $$rep{ntests}) {
27         $allpass++;
28     }
29
30     if (my $prev = load_summary $slot, 'previous') {
31         my $nfail = $$rep{ntests}  - $$rep{npass};
32         my $pfail = $$prev{ntests} - $$prev{npass};
33         $$rep{alert} = $$rep{ntests} && $nfail <=> $pfail;
34     }
35 }
36
37 $allpass = 100 * $allpass / @reps;
38 $allfail = 100 * $allfail / @reps;
39 my $warn = 100 - $allpass - $allfail;
40
41 my @sort = ('subarch', 'os', 'cc', 'slot');
42 my $sort = param('asort') || param('dsort');
43 my $sdir = param('dsort') ? -1 : 1;
44 defined $sort and unshift @sort, $sort eq 'arch'? 'subarch': $sort;
45 $sort ||= $sort[0];
46
47 sub repcmp {
48     my $r;
49     for my $s (@sort) {
50         last if $r = $sdir * (lc $$a{$s} cmp lc $$b{$s});
51     }
52     return $r;
53 };
54
55 (my $uri = $ENV{REQUEST_URI}) =~ s/\?.*//;
56 my $params = join '&', map param($_), grep $_ !~ 'sort', param;
57 $params .= '&' if $params;
58
59 sub lsort {
60     my ($text, $key, $p) = @_;
61     if ($sort eq $key) {
62         $p = param('asort') ? 'dsort' : 'asort';
63     }
64     if (!$p) {
65         $p = 'asort';
66     }
67     anchor $text, href => "$uri?$params$p=$key";
68 }
69
70 print "Content-type: text/html\r\n";
71
72 if ($ENV{HTTP_ACCEPT_ENCODING} =~ /gzip/) {
73     print "Content-Encoding: gzip\r\n\r\n";
74     open STDOUT, '|-', 'gzip';
75 } else {
76     print "\r\n";
77 }
78
79 doctype;
80 start 'html', xmlns => "http://www.w3.org/1999/xhtml";
81 start 'head';
82 tag 'meta', 'http-equiv' => "Content-Type",
83             'content'    => "text/html; charset=utf-8";
84 tag 'link', rel  => 'stylesheet',
85             type => 'text/css',
86             href => '/fate.css';
87 print "<title>FATE</title>\n";
88 print <<EOF;
89 <script type="text/javascript">
90   function toggle(id, arr) {
91       var e = document.getElementById(id);
92       if (e.style.display == 'table-row') {
93           e.style.display = 'none';
94           arr.textContent = '\\u25ba'
95       } else {
96           e.style.display = 'table-row';
97           arr.textContent = '\\u25bc'
98       }
99   }
100 </script>
101 EOF
102 end 'head';
103
104 start 'body';
105 h1 'FATE';
106
107 start 'table', id => 'index', class => 'replist';
108 start 'thead';
109 start 'tr';
110 start 'td', colspan => 7, id => 'failometer';
111 span '&nbsp;', class => 'pass', style => "width: ${allpass}%" if $allpass;
112 span '&nbsp;', class => 'warn', style => "width: ${warn}%"    if $warn;
113 span '&nbsp;', class => 'fail', style => "width: ${allfail}%" if $allfail;
114 end 'td';
115 end 'tr';
116 start 'tr';
117 start 'th'; lsort 'Time',     'date', 'dsort'; end 'th';
118 start 'th'; lsort 'Rev',      'rev';           end 'th';
119 start 'th'; lsort 'Arch',     'arch';          end 'th';
120 start 'th'; lsort 'OS',       'os';            end 'th';
121 start 'th'; lsort 'Compiler', 'cc';            end 'th';
122 start 'th', colspan => 2; lsort 'Result', 'npass'; end 'th';
123 end 'tr';
124 end 'thead';
125 start 'tbody';
126 for my $rep (sort repcmp @reps) {
127     my $ntest = $$rep{ntests};
128     my $npass = $$rep{npass};
129     my $time = parse_date $$rep{date};
130     my $age  = time - $time;
131     my $agestr = agestr $age, $time;
132     my $ageclass = '';
133     my $rtext;
134     my $rclass;
135     my $log;
136     my $alert = ('rejoice', '', 'alert')[$$rep{alert} + 1];
137     (my $slotid = $$rep{slot}) =~ s/[^a-z0-9_-]/_/ig;
138
139     if ($age < $recent_age) {
140         $ageclass = 'recent';
141     } elsif ($age > $ancient_age) {
142         $ageclass = 'ancient';
143     }
144
145     start 'tr', class => "$ageclass $alert alt hilight";
146     start 'td';
147     anchor $agestr, href => href slot => $$rep{slot};
148     end 'td';
149     if ($gitweb and $$rep{rev} =~ /git-(.*)/) {
150         start 'td';
151         anchor $$rep{rev}, href => "$gitweb;a=commit;h=$1";
152         end 'td';
153     } else {
154         td $$rep{rev};
155     }
156     td $$rep{subarch};
157     td $$rep{os};
158     td $$rep{cc};
159     if ($npass) {
160         $rtext  = "$npass / $ntest";
161         $rclass = $npass==$ntest? 'pass' : $npass? 'warn' : 'fail';
162     } else {
163         $rtext  = $$rep{errstr};
164         $rclass = 'fail';
165         for my $base ('test', 'compile', 'configure') {
166             my $file = "$fatedir/$$rep{slot}/$$rep{date}/$base.log.gz";
167             if (-r $file) {
168                 $log = qx{zcat $file | tail -n20};
169                 last;
170             }
171         }
172     }
173     start 'td', class => "$rclass resleft";
174     anchor $rtext, href => href slot => $$rep{slot}, time => $$rep{date};
175     end 'td';
176     start 'td', class => "$rclass resright";
177     if ($npass < $ntest or $log) {
178         span '&#9658;', class => 'toggle', onclick => "toggle('$slotid', this)";
179     }
180     end 'td';
181     end 'tr';
182     print "\n";
183     if ($npass < $ntest) {
184         my $report = load_report $$rep{slot}, $$rep{date};
185         my @fail = grep $$_{status} ne '0', @{$$report{recs}};
186         my $nfail = @fail;
187         start 'tr', id => $slotid, class => 'slotfail';
188         start 'td', colspan => 7;
189         start 'table', class => 'minirep';
190         start 'thead';
191         start 'tr';
192         th "$nfail failed tests";
193         th 'Status', class => 'errcode';
194         end 'tr';
195         end 'thead';
196         start 'tbody';
197         for (sort { $$a{name} cmp $$b{name} } @fail) {
198             start 'tr', class => 'alt hilight';
199             td $$_{name};
200             td $$_{status}, class => 'errcode';
201             end 'tr';
202         }
203         end 'tbody';
204         end 'table';
205         end 'td';
206         end 'tr';
207         print "\n";
208         trowa { style => 'display: none' }, '';
209     } elsif ($log) {
210         start 'tr', id => $slotid, class => 'slotfail';
211         start 'td', colspan => 7;
212         start 'pre', class => 'minilog';
213         print encode_entities($log, '<>&"');
214         end 'pre';
215         end 'td';
216         end 'tr';
217         trowa { style => 'display: none' }, '';
218     }
219 }
220 end 'tbody';
221 end 'table';
222 end 'body';
223 end 'html';