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