index: allow multiple sorting criteria
[fateserver.git] / index.cgi
index 6c9c69c..6603fda 100755 (executable)
--- a/index.cgi
+++ b/index.cgi
@@ -21,6 +21,19 @@ 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;
@@ -34,7 +47,15 @@ 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} == $$rep{ntests} and !$$rep{status}) {
         $allpass++;
@@ -43,22 +64,24 @@ for my $slot (@slots) {
     }
 
     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};
     }
 }
 
+@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;
 
 my @sort = ('subarch', 'os', 'cc', 'comment', 'slot');
-my $sort = param('asort') || param('dsort');
-my $sdir = param('dsort') ? -1 : 1;
-defined $sort and unshift @sort, $sort eq 'arch'? 'subarch': $sort;
+my $sdir = 1; # default to ascending sorting
+defined $sort and unshift @sort, split /\/\//, $sort;
 $sort ||= $sort[0];
 
 sub nscmp {
@@ -69,24 +92,66 @@ sub nscmp {
 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;
 };
 
-(my $uri = $ENV{REQUEST_URI}) =~ s/\?.*//;
-my $params = join '&', map param($_), grep $_ !~ 'sort', param;
-$params .= '&' if $params;
-
 sub lsort {
-    my ($text, $key, $p) = @_;
-    if ($sort eq $key) {
-        $p = param('asort') ? 'dsort' : 'asort';
+    my $params = '';
+    for my $thisparam (param) {
+        next if $thisparam =~ 'sort';
+        $params .= '&' if $params ne '';
+        $params .= "$thisparam=" . param($thisparam);
     }
-    if (!$p) {
-        $p = 'asort';
+    $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$p=$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";
@@ -135,6 +200,17 @@ 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';
@@ -145,7 +221,7 @@ span '&nbsp;', class => 'fail', style => "width: ${allfail}%" if $allfail;
 end 'td';
 end 'tr';
 start 'tr';
-start 'th'; lsort 'Time',     'date', 'dsort'; end 'th';
+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';
@@ -188,9 +264,10 @@ for my $rep (sort repcmp @reps) {
     } else {
         td $$rep{rev};
     }
-    td $$rep{subarch};
-    td $$rep{os};
-    td $$rep{cc};
+
+    category 'subarch', $rep;
+    category 'os', $rep;
+    category 'cc', $rep;
     td $$rep{comment}, class => 'comment';
     if ($npass) {
         $rtext  = "$npass / $ntest";
@@ -231,7 +308,6 @@ for my $rep (sort repcmp @reps) {
     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';
@@ -239,10 +315,10 @@ for my $rep (sort repcmp @reps) {
         start 'table', class => 'minirep';
         start 'thead';
         start 'tr';
-        if ($nfail eq 1) {
-            th "$nfail failed test";
+        if ($$rep{nfail} eq 1) {
+            th "1 failed test";
         } else {
-            th "$nfail failed tests";
+            th "$$rep{nfail} failed tests";
         }
         th 'Status', class => 'errcode';
         end 'tr';