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