Add 4.next branch

[buildfarm-server.git] / cgi-bin / show_history.pl

diff --git a/cgi-bin/show_history.pl b/cgi-bin/show_history.pl
index b55c381b6cb364a418138bf9c5b3345515738bd5..50b1bf384cf85af6ea8d8c950385fb6871ce1949 100755 (executable)
--- a/cgi-bin/show_history.pl
+++ b/cgi-bin/show_history.pl
@@ -1,5 +1,13 @@
 #!/usr/bin/perl
 
 #!/usr/bin/perl
 

+=comment
+
+Copyright (c) 2003-2010, Andrew Dunstan
+
+See accompanying License file for license details
+
+=cut 
+

 use strict;
 use DBI;
 use Template;
 use strict;
 use DBI;
 use Template;


@@ -7,9 +15,8 @@ use CGI;
 
 use vars qw($dbhost $dbname $dbuser $dbpass $dbport $template_dir);
 
 
 use vars qw($dbhost $dbname $dbuser $dbpass $dbport $template_dir);
 

-
-require "$ENV{BFConfDir}/BuildFarmWeb.pl";
-#require "BuildFarmWeb.pl";
+use FindBin qw($RealBin);
+require "$RealBin/../BuildFarmWeb.pl";

 
 die "no dbname" unless $dbname;
 die "no dbuser" unless $dbuser;
 
 die "no dbname" unless $dbname;
 die "no dbuser" unless $dbuser;


@@ -24,7 +31,7 @@ die $DBI::errstr unless $db;
 
 my $query = new CGI;
 my $member = $query->param('nm'); $member =~ s/[^a-zA-Z0-9_ -]//g;
 
 my $query = new CGI;
 my $member = $query->param('nm'); $member =~ s/[^a-zA-Z0-9_ -]//g;

-my $branch = $query->param('br'); $branch =~ s/[^a-zA-Z0-9_ -]//g;
+my $branch = $query->param('br'); $branch =~ s/[^a-zA-Z0-9+_ .-]//g;

 my $hm = $query->param('hm');  $hm =~ s/[^a-zA-Z0-9_ -]//g;
 $hm = '240' unless $hm =~ /^\d+$/;
 
 my $hm = $query->param('hm');  $hm =~ s/[^a-zA-Z0-9_ -]//g;
 $hm = '240' unless $hm =~ /^\d+$/;
 


@@ -35,40 +42,86 @@ my $latest_personality = $db->selectrow_arrayref(q{
             order by effective_date desc limit 1
        }, undef, $member);
 
             order by effective_date desc limit 1
        }, undef, $member);
 

-# we don't really need to do this join, since we only want
-# one row from buildsystems. but it means we only have to run one
-# query. If it gets heavy we'll split it up and run two
-
-my $statement = <<EOS;
-
-  select (now() at time zone 'GMT')::timestamp(0) - snapshot as when_ago,
-      sysname, snapshot, b.status, stage,
-      operating_system, os_version, compiler, compiler_version, architecture,
-      owner_email,
-      sys_notes_ts::date AS sys_notes_date, sys_notes
-  from buildsystems s, 
-       build_status b 
-  where name = ?
-        and branch = ?
-        and s.status = 'approved'
-        and name = sysname
-  order by snapshot desc
-  limit $hm
-
-EOS
+my $systemdata = q{
+    select operating_system, os_version, compiler, compiler_version, architecture,
+      owner_email, sys_notes_ts::date AS sys_notes_date, sys_notes
+    from buildsystems b
+    where b.status = 'approved'
+        and name = ?
+};
+
+my $statement = qq{
+   WITH x AS 
+   (  select * 
+      from build_status_recent_500
+      where sysname = ? 
+         and branch = ?
+   )
+   SELECT (now() at time zone 'GMT')::timestamp(0) - x.snapshot as when_ago, 
+            x.sysname, x.snapshot, x.status, x.stage, s.log_text
+   FROM x 
+   LEFT JOIN build_status_log s
+   ON x.snapshot = s.snapshot AND s.log_stage = 'test-results.log'
+   ORDER BY x.snapshot desc  
+   LIMIT $hm
+}

 ;
 
 ;
 

+my $sth = $db->prepare($systemdata);
+$sth->execute($member);
+my $sysrow = $sth->fetchrow_hashref;

 my $statrows=[];
 my $statrows=[];

-my $sth=$db->prepare($statement);
+$sth=$db->prepare($statement);

 $sth->execute($member,$branch);
 while (my $row = $sth->fetchrow_hashref)
 {
 $sth->execute($member,$branch);
 while (my $row = $sth->fetchrow_hashref)
 {

+    last unless $sysrow;
+    while (my($k,$v) = each %$sysrow) { $row->{$k} = $v; }

     $row->{owner_email} =~ s/\@/ [ a t ] /;
     if ($latest_personality)
     {
        $row->{os_version} = $latest_personality->[0];
        $row->{compiler_version} = $latest_personality->[1];
     }
     $row->{owner_email} =~ s/\@/ [ a t ] /;
     if ($latest_personality)
     {
        $row->{os_version} = $latest_personality->[0];
        $row->{compiler_version} = $latest_personality->[1];
     }

+
+    # convert list of individual testresults to list of ranges of equal results
+    # for speed of display
+    if (defined($row->{log_text}))
+      {         # convert to a hash, find ranges, output list of ranges
+      my $h = { split /\s+/, $row->{log_text} };
+      my $i;
+      my $start;
+      my @ranges;
+
+      foreach my $k (sort {$a<=>$b} keys %$h)
+        {
+        if (defined $start)
+          {
+          if ($h->{$k} ne $h->{$start})
+            {
+            push @ranges, sprintf("%s %s %s", $h->{$start},  $start,  $i);
+            $start = $k;
+            $i = 1;
+            }
+          else
+            {
+            $i++;
+            }
+          }
+        else
+          {
+          $start = $k;
+          $i = 1;
+          }
+        }
+      if (defined $start)
+        {
+        push @ranges, sprintf("%s %s %s", $h->{$start},  $start,  $i);
+        }
+
+      $row->{log_text} = \@ranges;
+      }
+

     push(@$statrows,$row);
 }
 
     push(@$statrows,$row);
 }