Fix querying of architecture for entries without subarch string
[fateserver.git] / report.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 POSIX qw/asctime/;
21 use CGI qw/param/;
22 use HTML::Entities;
23 use MIME::Base64;
24 use FATE;
25
26 my $req_slot = param 'slot';
27 my $req_time = param 'time';
28
29 my $slotdir = "$fatedir/$req_slot";
30 my $repdir = "$slotdir/$req_time";
31 my $report = "$repdir/report.xz";
32
33 open R, '-|', "unxz -c $report" or fail 'Requsted report not found';
34
35 my $hdr  = split_header scalar <R> or fail 'Invalid report';
36 my $conf = split_config scalar <R> or fail 'Invalid report';
37 $$hdr{version} eq '0'              or fail 'Bad report version';
38
39 my %pass;
40 my %fail;
41
42 while (<R>) {
43     my $rec = split_rec $_;
44     ${$$rec{status}? \%fail: \%pass}{$$rec{name}} = $rec;
45 }
46
47 close R;
48
49 my $npass = keys %pass;
50 my $nfail = keys %fail;
51 my $ntest = $npass + $nfail;
52
53 my $rep = load_summary $req_slot, $req_time;
54 my $lastpass = load_lastpass $req_slot;
55
56 my $owner;
57 if (open O, "$slotdir/owner") {
58     chomp($owner = <O>);
59     close O;
60 }
61
62 # main text
63
64 print "Content-type: text/html\r\n";
65
66 if ($ENV{HTTP_ACCEPT_ENCODING} =~ /gzip/) {
67     print "Content-Encoding: gzip\r\n\r\n";
68     open STDOUT, '|-', 'gzip';
69 } else {
70     print "\r\n";
71 }
72
73 doctype;
74 start 'html', xmlns => "http://www.w3.org/1999/xhtml";
75 start 'head';
76 tag 'meta', 'http-equiv' => "Content-Type",
77             'content'    => "text/html; charset=utf-8";
78 tag 'link', rel  => 'stylesheet',
79             type => 'text/css',
80             href => '//ffmpeg.org/default.css';
81 tag 'link', rel  => 'stylesheet',
82             type => 'text/css',
83             href => '/fate.css';
84 print "<title>FATE: $$hdr{slot} $$hdr{rev}</title>\n";
85 print <<EOF;
86 <script type="text/javascript">
87   function toggle(id) {
88       var e = document.getElementById(id);
89       e.style.display = e.style.display == 'table-row' ? 'none' : 'table-row';
90   }
91   function hide(id) {
92       var e = document.getElementById(id);
93       e.style.display = 'none';
94   }
95   function show_diff(name) {
96       hide(name + '-err');
97       toggle(name + '-diff');
98   }
99   function show_err(name) {
100       hide(name + '-diff');
101       toggle(name + '-err');
102   }
103 </script>
104 EOF
105 end 'head';
106
107 start 'body';
108 start 'div', id => 'container';
109
110 navbar;
111
112 start 'div', id => 'body';
113
114 h1 "$$hdr{slot} $$hdr{rev}", id => 'title';
115
116 start 'table', id => 'config';
117 trow 'Architecture',  $$conf{arch};
118 trow 'Variant',       $$conf{subarch};
119 trow 'CPU',           $$conf{cpu};
120 trow 'OS',            $$conf{os};
121 trow 'Owner',         $owner if $owner;
122 trow 'Compiler',      $$conf{cc};
123 trow 'Configuration', $$conf{config};
124 trow 'Comment',       $$hdr{comment};
125 start 'tr';
126 td   'Revision';
127 if ($gitweb and $$hdr{rev} =~ /(N-)?(.*)/) {
128     start 'td';
129     anchor $$hdr{rev}, href => "$gitweb;a=commit;h=$2";
130     end 'td';
131 } else {
132     td $$hdr{rev};
133 }
134 end 'tr';
135 trow 'Date',          asctime gmtime parse_date $$hdr{date};
136 trow 'Status',        $npass? "$npass / $ntest" : "$$hdr{errstr} ($$hdr{status})";
137 trow 'Warnings',      $$rep{nwarn};
138 start 'tr';
139 td 'Logs';
140 start 'td';
141 while (my $logfile = glob "$repdir/*.log.gz") {
142     my ($log) = $logfile =~ m!^$repdir/([a-z_.-]+)\.log\.gz$! or next;
143     anchor $log, href => href slot=>$$hdr{slot}, time=>$$hdr{date}, log=>$log;
144     print "\n";
145 }
146 end 'td';
147 end 'tr';
148 end;
149
150 start 'table', id => 'tests', class => 'replist';
151 if ($nfail) {
152     start 'thead';
153     start 'tr', class => 'fail';
154     if ($nfail eq 1) {
155         th "$nfail failed test", colspan => 3;
156     } else {
157         th "$nfail failed tests", colspan => 3;
158     }
159     th 'Status', class => 'errcode';
160     th 'Last good rev', class => 'lastpass';
161     end 'tr';
162     end 'thead';
163     start 'tbody';
164     for my $n (sort keys %fail) {
165         my $rec = $fail{$n};
166         my $test = $$rec{name};
167         my $diff = encode_entities decode_base64($$rec{diff}), '<>&"';
168         my $err  = encode_entities decode_base64($$rec{stderr}), '<>&"';
169         if ($diff =~ /^--- /) {
170             $diff =~ s!^--- .*$!<span class="diff-old">$&</span>!gm;
171             $diff =~ s!^\+\+\+ .*$!<span class="diff-new">$&</span>!gm;
172             $diff =~ s!^\@\@.*\@\@.*$!<span class="diff-hnk">$&</span>!gm;
173             $diff =~ s!^-.*$!<span class="diff-del">$&</span>!gm;
174             $diff =~ s!^\+.*$!<span class="diff-add">$&</span>!gm;
175             $diff =~ s!^ .*$!<span class="diff-nop">$&</span>!gm;
176         }
177         if ($diff =~ /^\s*$/) {
178             $diff = '<em>No diff output recorded</em>';
179         }
180         start 'tr', class => 'alt hilight';
181         td "diff",    class => 'toggle', onclick => "show_diff('$test')";
182         td "stderr",  class => 'toggle', onclick => "show_err('$test')";
183         td $test;
184         td $$rec{status}, class => 'errcode';
185         if ($$lastpass{$n} and $gitweb) {
186             my ($old, $new);
187             $$lastpass{$n}{rev} =~ /(N-)?(.*)/ and $old = $2;
188             $$hdr{rev}          =~ /(N-)?(.*)/ and $new = $2;
189             if ($old and $new) {
190                 start 'td';
191                 anchor $$lastpass{$n}{rev}, href => "$gitweb;a=shortlog;h=$new;hp=$old";
192                 end 'td';
193             } else {
194                 td $$lastpass{$n}{rev};
195             }
196         } else {
197             td $$lastpass{$n}? $$lastpass{$n}{rev} : 'n / a';
198         }
199         end 'tr';
200         start 'tr', id => "$test-diff", class => 'diff';
201         td $diff, colspan => 5;
202         end 'tr';
203         start 'tr', id => "$test-err",  class => 'diff';
204         td $err,  colspan => 5;
205         end 'tr';
206     }
207     end 'tbody';
208 } elsif ($ntest) {
209     start 'tr'; th 'All tests successful', colspan => 3, class => 'pass'; end;
210 } else {
211     my $class = $$hdr{status}? 'fail' : 'pass';
212     start 'tr'; th 'No tests were run',    colspan => 3, class => $class; end;
213 }
214 end 'table';
215
216 end 'div';
217 end 'div';
218 end 'body';
219 end 'html';