index: allow multiple sorting criteria
[fateserver.git] / index.cgi
index e7e864c..6603fda 100755 (executable)
--- a/index.cgi
+++ b/index.cgi
@@ -1,9 +1,39 @@
 #! /usr/bin/perl
+#
+# Copyright (c) 2011 Mans Rullgard <mans@mansr.com>
+#
+# Permission to use, copy, modify, and distribute this software for any
+# purpose with or without fee is hereby granted, provided that the above
+# copyright notice and this permission notice appear in all copies.
+#
+# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHORS DISCLAIM ALL WARRANTIES
+# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR
+# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 
 use strict;
 use warnings;
 
+use CGI qw/param/;
+use HTML::Entities;
 use FATE;
+use Time::Zone;
+use URI::Escape;
+
+# Format for /?query= : /?query=type:value//type:value// (URI encoded).
+# Trailing // does not matter (i.e. may be added).
+# @queries contains an array of 'type:value' strings.
+# Every member of @queries can be further parsed with another simple
+# split(/:/, $this_query, 2);
+my @queries = split(/\/\//, uri_unescape param 'query') if (param 'query');
+
+my $sort = param('sort');
+$sort    = $sort eq 'arch' ? 'subarch': $sort;
+
+(my $uri = $ENV{REQUEST_URI}) =~ s/\?.*//;
 
 opendir D, $fatedir or fail 'Server error: $fatedir not found';
 my @slots = grep /^[^.]/, readdir D;
@@ -14,26 +44,124 @@ my $allpass = 0;
 my $allfail = 0;
 
 for my $slot (@slots) {
+    next if -e "$fatedir/$slot/hidden";
     my $rep = load_summary $slot, 'latest' or next;
+    next if time - parse_date($$rep{date}) > $hidden_age;
+
+    my $not_matched = 0;
+    $$rep{subarch} = $$rep{arch} if not $$rep{subarch};
+    for my $this_query (@queries) {
+        my ($type, $text) = split(/:/, $this_query, 2);
+        $not_matched = 1 if ($$rep{$type} ne $text);
+    }
+    next if $not_matched;
+
     push @reps, $rep;
-    if ($$rep{npass} == 0) {
-        $allfail++;
-    } elsif ($$rep{npass} == $$rep{ntests}) {
+    if ($$rep{npass} == $$rep{ntests} and !$$rep{status}) {
         $allpass++;
+    } elsif ($$rep{npass} == 0) {
+        $allfail++;
     }
 
     if (my $prev = load_summary $slot, 'previous') {
-        my $nfail = $$rep{ntests}  - $$rep{npass};
         my $pfail = $$prev{ntests} - $$prev{npass};
-        $$rep{alert} = $$rep{ntests} && $nfail <=> $pfail;
+        $$rep{alert} = $$rep{ntests} && $$rep{nfail} <=> $pfail;
+        $$rep{dwarn} = $$rep{nwarn} <=> $$prev{nwarn};
+        $$rep{pdate} = $$prev{date};
     }
 }
 
-$allpass = int 100 * $allpass / @reps;
-$allfail = int 100 * $allfail / @reps;
-my $warn = int 100 - $allpass - $allfail;
+@reps or fail @queries ? 'No items matching search criteria. ' .
+                         "<a href=\"$uri\">Clear all search criteria.</a>" :
+                         'No data in $fatedir.';
+
+$allpass = 100 * $allpass / @reps;
+$allfail = 100 * $allfail / @reps;
+my $warn = 100 - $allpass - $allfail;
 
-print "Content-type: text/html\r\n\r\n";
+my @sort = ('subarch', 'os', 'cc', 'comment', 'slot');
+my $sdir = 1; # default to ascending sorting
+defined $sort and unshift @sort, split /\/\//, $sort;
+$sort ||= $sort[0];
+
+sub nscmp {
+    my ($a, $b) = @_;
+    return int $a || int $b ? $a <=> $b : lc $a cmp lc $b;
+}
+
+sub repcmp {
+    my $r;
+    for my $s (@sort) {
+        if ($s =~ /^desc/) {
+            $s =~ s/^desc//;
+            $sdir = -1;
+        }
+        last if $r = $sdir * nscmp $$a{$s}, $$b{$s};
+    }
+    return $r;
+};
+
+sub lsort {
+    my $params = '';
+    for my $thisparam (param) {
+        next if $thisparam =~ 'sort';
+        $params .= '&' if $params ne '';
+        $params .= "$thisparam=" . param($thisparam);
+    }
+    $params .= '&' if $params;
+    my ($text, $key) = @_;
+
+    if ($sort eq $key) {                           # $sort = $key
+        if ($key =~ /^desc/) {                     # $sort = desc*
+            $key =~ s/^desc//;
+        } else {                                   # $sort = *
+            $key = "desc$key";
+        }
+    }
+
+    anchor $text, href => "$uri?${params}sort=$key";
+}
+
+sub category {
+    my ($category, $rep) = @_;
+    my $head_printed = 0;
+
+    # $params will contain parameters else than query, if any, in HTTP format.
+    my $params = '';
+    for my $thisparam (param) {
+        next if $thisparam eq 'query';
+        $params .= '&' if $params ne '';
+        $params .= "$thisparam=" . param($thisparam);
+    }
+    my $head = ($params ? '&' : '') . 'query=';
+
+    if (@queries) {
+        for my $this_query (@queries) {
+            my ($type, $text) = split(/:/, $this_query, 2);
+            if ($type ne $category) {
+                $params .= $head if (!$head_printed);
+                $params .= $this_query . '//';
+                $head_printed = 1;
+            }
+        }
+    }
+    $params .= $head if (!$head_printed);
+    $params .= "$category:" . uri_escape_utf8 "$$rep{$category}" . '//';
+    $head_printed = 1;                 # for the sake of completeness
+
+    start 'td';
+    anchor $$rep{$category}, href => "$uri?$params";
+    end 'td';
+}
+
+print "Content-type: text/html\r\n";
+
+if ($ENV{HTTP_ACCEPT_ENCODING} =~ /gzip/) {
+    print "Content-Encoding: gzip\r\n\r\n";
+    open STDOUT, '|-', 'gzip';
+} else {
+    print "\r\n";
+}
 
 doctype;
 start 'html', xmlns => "http://www.w3.org/1999/xhtml";
@@ -42,7 +170,10 @@ tag 'meta', 'http-equiv' => "Content-Type",
             'content'    => "text/html; charset=utf-8";
 tag 'link', rel  => 'stylesheet',
             type => 'text/css',
-            href => 'fate.css';
+            href => '//ffmpeg.org/default.css';
+tag 'link', rel  => 'stylesheet',
+            type => 'text/css',
+            href => '/fate.css';
 print "<title>FATE</title>\n";
 print <<EOF;
 <script type="text/javascript">
@@ -50,7 +181,7 @@ print <<EOF;
       var e = document.getElementById(id);
       if (e.style.display == 'table-row') {
           e.style.display = 'none';
-          arr.textContent = '\\u25ba'
+          arr.textContent = '\\u25b6'
       } else {
           e.style.display = 'table-row';
           arr.textContent = '\\u25bc'
@@ -61,86 +192,142 @@ EOF
 end 'head';
 
 start 'body';
+start 'div', id => 'container';
+
+navbar;
+
+start 'div', id => 'body';
+
 h1 'FATE';
 
+if (@queries) {
+    start 'p';
+    print 'Search patterns: ';
+    for my $this_query (@queries) {
+        my ($type, $text) = split(/:/, $this_query, 2);
+        print "$type: $text; ";
+    }
+    anchor 'clear all.', href => "$uri";
+    end 'p';
+}
+
 start 'table', id => 'index', class => 'replist';
 start 'thead';
 start 'tr';
-start 'td', colspan => 7, id => 'failometer';
-span '&nbsp;', class => 'pass', style => "width: ${allpass}%";
-span '&nbsp;', class => 'warn', style => "width: ${warn}%";
-span '&nbsp;', class => 'fail', style => "width: ${allfail}%";
+start 'td', colspan => 10, id => 'failometer';
+span '&nbsp;', class => 'pass', style => "width: ${allpass}%" if $allpass;
+span '&nbsp;', class => 'warn', style => "width: ${warn}%"    if $warn;
+span '&nbsp;', class => 'fail', style => "width: ${allfail}%" if $allfail;
 end 'td';
 end 'tr';
 start 'tr';
-th 'Time';
-th 'Arch';
-th 'OS';
-th 'Compiler';
-th 'Rev';
-th 'Result', colspan => 2;
+start 'th'; lsort 'Time',     'descdate';      end 'th';
+start 'th'; lsort 'Rev',      'rev';           end 'th';
+start 'th'; lsort 'Arch',     'arch';          end 'th';
+start 'th'; lsort 'OS',       'os';            end 'th';
+start 'th'; lsort 'Compiler', 'cc';            end 'th';
+start 'th'; lsort 'Comment',  'comment';       end 'th';
+start 'th', colspan => 2; lsort 'Warnings', 'nwarn'; end 'th';
+start 'th', colspan => 2; lsort 'Tests', 'npass'; end 'th';
 end 'tr';
 end 'thead';
 start 'tbody';
-for my $rep (sort { $$a{slot} cmp $$b{slot} } @reps) {
+for my $rep (sort repcmp @reps) {
     my $ntest = $$rep{ntests};
     my $npass = $$rep{npass};
     my $time = parse_date $$rep{date};
-    my $age  = time - $time;
+    my $age  = time - tz_local_offset() - $time;
     my $agestr = agestr $age, $time;
     my $ageclass = '';
     my $rtext;
     my $rclass;
+    my $log;
     my $alert = ('rejoice', '', 'alert')[$$rep{alert} + 1];
+    my $walert = ('rejoice', '', 'alert')[$$rep{dwarn} + 1];
     (my $slotid = $$rep{slot}) =~ s/[^a-z0-9_-]/_/ig;
 
     if ($age < $recent_age) {
         $ageclass = 'recent';
     } elsif ($age > $ancient_age) {
         $ageclass = 'ancient';
+        $alert = '';
     }
 
     start 'tr', class => "$ageclass $alert alt hilight";
     start 'td';
-    anchor $agestr, href => "history.cgi?slot=$$rep{slot}";
+    anchor $agestr, href => href slot => $$rep{slot};
     end 'td';
-    td $$rep{subarch} || $$rep{arch};
-    td $$rep{os};
-    td $$rep{cc};
-    td $$rep{rev};
+    if ($gitweb and $$rep{rev} =~ /(N-)?(.*)/) {
+        start 'td';
+        anchor $$rep{rev}, href => "$gitweb;a=commit;h=$2";
+        end 'td';
+    } else {
+        td $$rep{rev};
+    }
+
+    category 'subarch', $rep;
+    category 'os', $rep;
+    category 'cc', $rep;
+    td $$rep{comment}, class => 'comment';
     if ($npass) {
         $rtext  = "$npass / $ntest";
         $rclass = $npass==$ntest? 'pass' : $npass? 'warn' : 'fail';
+    } elsif (!$ntest and !$$rep{status}) {
+        $rtext  = "build only";
+        $rclass = $$rep{status}? 'fail' : 'pass';
     } else {
         $rtext  = $$rep{errstr};
-        $rclass = 'fail'
+        $rclass = 'fail';
+        for my $base ('test', 'compile', 'configure') {
+            my $file = "$fatedir/$$rep{slot}/$$rep{date}/$base.log.gz";
+            if (-r $file) {
+                $log = qx{zcat $file | tail -n20};
+                last;
+            }
+        }
     }
+    start 'td', class => 'warnleft';
+    anchor $$rep{nwarn}, class => $walert,
+      href => href slot => $$rep{slot}, time => $$rep{date}, log => 'compile';
+    end;
+    start 'td', class => 'warnright';
+    anchor '±', class => $walert,
+      href => href slot => $$rep{slot}, time => $$rep{date},
+        log => "compile/$$rep{pdate}";
+    end;
     start 'td', class => "$rclass resleft";
-    anchor $rtext, href => "report.cgi?slot=$$rep{slot}&amp;time=$$rep{date}";
+    anchor $rtext, href => href slot => $$rep{slot}, time => $$rep{date};
     end 'td';
     start 'td', class => "$rclass resright";
-    if ($npass < $ntest) {
-        span '&#9658;', class => 'toggle', onclick => "toggle('$slotid', this)";
+    if ($npass < $ntest or $log) {
+        span '&#9654;', class => 'toggle', onclick => "toggle('$slotid', this)";
     }
     end 'td';
     end 'tr';
     print "\n";
-    if ($npass < $ntest) {
+    if ($npass < $ntest && $ntest - $npass < 100) {
         my $report = load_report $$rep{slot}, $$rep{date};
         my @fail = grep $$_{status} ne '0', @{$$report{recs}};
-        my $nfail = @fail;
+        my $lastpass = load_lastpass $$rep{slot};
+
         start 'tr', id => $slotid, class => 'slotfail';
-        start 'td', colspan => 7;
+        start 'td', colspan => 10;
         start 'table', class => 'minirep';
         start 'thead';
         start 'tr';
-        th "$nfail failed tests";
+        if ($$rep{nfail} eq 1) {
+            th "1 failed test";
+        } else {
+            th "$$rep{nfail} failed tests";
+        }
         th 'Status', class => 'errcode';
         end 'tr';
         end 'thead';
         start 'tbody';
         for (sort { $$a{name} cmp $$b{name} } @fail) {
-            start 'tr', class => 'alt hilight';
+            my $falert = $$rep{pdate} eq $$lastpass{$$_{name}}{date} ?
+              'alert' : '';
+            start 'tr', class => "alt hilight $falert";
             td $$_{name};
             td $$_{status}, class => 'errcode';
             end 'tr';
@@ -151,9 +338,20 @@ for my $rep (sort { $$a{slot} cmp $$b{slot} } @reps) {
         end 'tr';
         print "\n";
         trowa { style => 'display: none' }, '';
+    } elsif ($log) {
+        start 'tr', id => $slotid, class => 'slotfail';
+        start 'td', colspan => 10;
+        start 'pre', class => 'minilog';
+        print encode_entities($log, '<>&"');
+        end 'pre';
+        end 'td';
+        end 'tr';
+        trowa { style => 'display: none' }, '';
     }
 }
 end 'tbody';
 end 'table';
+end 'div';
+end 'div';
 end 'body';
 end 'html';