git://git.exim.org / buildfarm-server.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Add testcases detail column to status page
[buildfarm-server.git] / cgi-bin / show_log.pl
diff --git a/cgi-bin/show_log.pl b/cgi-bin/show_log.pl
index d282c1e3e57113a437d5fee8df029070b98ac487..ab3d3cdb00050140c1a6cbda0eeac81ef973f127 100755 (executable)
--- a/cgi-bin/show_log.pl
+++ b/cgi-bin/show_log.pl
@@ -1,16 +1,26 @@
 #!/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 CGI;
 use strict;
 use DBI;
 use Template;
 use CGI;
-use URI::Escape;
 
 
-use vars qw($dbhost $dbname $dbuser $dbpass $dbport @log_file_names);
+use vars qw($dbhost $dbname $dbuser $dbpass $dbport 
+                       $template_dir @log_file_names $local_git_clone);
 
 
+use FindBin qw($RealBin);
+require "$RealBin/../BuildFarmWeb.pl";
 
 
-require "$ENV{BFConfDir}/BuildFarmWeb.pl";
-#require "BuildFarmWeb.pl";
+my $template_opts = { INCLUDE_PATH => $template_dir, EVAL_PERL => 1};
+my $template = new Template($template_opts);
 
 die "no dbname" unless $dbname;
 die "no dbuser" unless $dbuser;
 
 die "no dbname" unless $dbname;
 die "no dbuser" unless $dbuser;
@@ -22,358 +32,212 @@ $dsn .= ";port=$dbport" if $dbport;
 my $query = new CGI;
 
 my $system = $query->param('nm'); $system =~ s/[^a-zA-Z0-9_ -]//g;
 my $query = new CGI;
 
 my $system = $query->param('nm'); $system =~ s/[^a-zA-Z0-9_ -]//g;
-my $logdate = $query->param('dt'); $logdate =~ s/[^a-zA-Z0-9_ -]//g;
+my $logdate = $query->param('dt'); $logdate =~ s/[^a-zA-Z0-9_ :-]//g;
 
 my $log = "";
 my $conf = "";
 my ($stage,$changed_this_run,$changed_since_success,$sysinfo,$branch,$scmurl);
 my $scm;
 
 my $log = "";
 my $conf = "";
 my ($stage,$changed_this_run,$changed_since_success,$sysinfo,$branch,$scmurl);
 my $scm;
+my ($git_head_ref, $last_build_git_ref, $last_success_git_ref);
+my ($stage_times, $run_time);
 
 use vars qw($info_row);
 
 if ($system && $logdate)
 {
 
 
 use vars qw($info_row);
 
 if ($system && $logdate)
 {
 
-       my $db = DBI->connect($dsn,$dbuser,$dbpass);
+       my $db = DBI->connect($dsn,$dbuser,$dbpass,{pg_expand_array => 0});
 
        die $DBI::errstr unless $db;
 
 
        die $DBI::errstr unless $db;
 
-       my $statement = <<EOS;
-
-  select log,conf_sum,stage, changed_this_run, changed_since_success,branch,
-      log_archive_filenames, scm, scmurl
-  from build_status
-  where sysname = ? and snapshot = ?
-
-EOS
-;
+       my $statement = q{
+
+               select log,conf_sum,stage, changed_this_run, changed_since_success,
+                branch,        log_archive_filenames, scm, scmurl, git_head_ref
+               from build_status
+               where sysname = ? and snapshot = ?
+
+       };
+       my $last_build_statement = q{
+               select git_head_ref 
+                from build_status 
+                where sysname = ? and branch = ?  and snapshot =
+                    (select max(snapshot)
+                    from build_status
+                    where sysname = ? and branch = ? and snapshot < ?)
+       };
+       my $last_success_statement = q{
+               select git_head_ref 
+                from build_status 
+                where sysname = ? and branch = ?  and snapshot =
+                    (select max(snapshot)
+                    from build_status
+                    where sysname = ? and branch = ? and snapshot < ? and stage = 'OK')
+       };
        my $sth=$db->prepare($statement);
        $sth->execute($system,$logdate);
        my $row=$sth->fetchrow_arrayref;
        my $sth=$db->prepare($statement);
        $sth->execute($system,$logdate);
        my $row=$sth->fetchrow_arrayref;
+       $branch = $row->[5];
+       $git_head_ref = $row->[9];
+       $sth->finish;
+       my $last_build_row;
+       if ($git_head_ref)
+       {
+               $last_build_row = 
+                 $db->selectrow_hashref($last_build_statement,undef,
+                                                                $system, $branch,$system,$branch,$logdate);
+               $last_build_git_ref = $last_build_row->{git_head_ref}
+                 if $last_build_row;
+               
+       }
+       my $last_success_row;
+       if (ref $last_build_row && $last_build_row->{stage} ne 'OK')
+       {
+               $last_success_row =
+                 $db->selectrow_hashref($last_success_statement,undef,
+                                                                $system,$branch,$system,$branch,$logdate);
+               $last_success_git_ref = $last_success_row->{git_head_ref}
+                 if $last_success_row;
+       }
        $log=$row->[0];
        $conf=$row->[1] || "not recorded" ;
        $stage=$row->[2] || "unknown";
        $changed_this_run = $row->[3];
        $changed_since_success = $row->[4];
        $log=$row->[0];
        $conf=$row->[1] || "not recorded" ;
        $stage=$row->[2] || "unknown";
        $changed_this_run = $row->[3];
        $changed_since_success = $row->[4];
-       $branch = $row->[5];
        my $log_file_names = $row->[6];
        $scm = $row->[7];
        $scm ||= 'cvs'; # legacy scripts
        $scmurl = $row->[8];
        my $log_file_names = $row->[6];
        $scm = $row->[7];
        $scm ||= 'cvs'; # legacy scripts
        $scmurl = $row->[8];
+       $scmurl = undef unless $scmurl =~ /^http/; # slight sanity check
+       $scmurl = 'http://git.postgresql.org/gitweb?p=postgresql.git;a=commit;h=' 
+           if ($scmurl eq 'http://git.postgresql.org/git/postgresql.git');
        $log_file_names =~ s/^\{(.*)\}$/$1/;
        @log_file_names=split(',',$log_file_names)
            if $log_file_names;
        $log_file_names =~ s/^\{(.*)\}$/$1/;
        @log_file_names=split(',',$log_file_names)
            if $log_file_names;
-       $sth->finish;
 
 
-       $statement = <<EOS;
+       $statement = q{
 
           select operating_system, os_version, 
                  compiler, compiler_version, 
                  architecture,
 
           select operating_system, os_version, 
                  compiler, compiler_version, 
                  architecture,
-                replace(owner_email,'\@',' [ a t ] ') as owner_email,
+                replace(owner_email,E'\@',' [ a t ] ') as owner_email,
                 sys_notes_ts::date AS sys_notes_date, sys_notes
           from buildsystems 
           where status = 'approved'
                 and name = ?
 
                 sys_notes_ts::date AS sys_notes_date, sys_notes
           from buildsystems 
           where status = 'approved'
                 and name = ?
 
-EOS
-;
+       };
        $sth=$db->prepare($statement);
        $sth->execute($system);
        $info_row=$sth->fetchrow_hashref;
        $sth=$db->prepare($statement);
        $sth->execute($system);
        $info_row=$sth->fetchrow_hashref;
-        # $sysinfo = join(" ",@$row);
+
+       my $latest_personality = $db->selectrow_arrayref(q{
+           select os_version, compiler_version
+           from personality
+           where effective_date < ?
+           and name = ?
+           order by effective_date desc limit 1
+       }, undef, $logdate, $system);
+       if ($latest_personality)
+       {
+           $info_row->{os_version} = $latest_personality->[0];
+           $info_row->{compiler_version} = $latest_personality->[1];
+       }
        $sth->finish;
        $sth->finish;
+       my $stage_times_query = q{
+           select log_stage, stage_duration
+           from build_status_log
+           where sysname = ? and snapshot = ?
+        };
+       $stage_times = 
+           $db->selectall_hashref($stage_times_query,'log_stage',undef,
+                                  $system,$logdate);
+       $stage_times_query = q{
+           select sum(stage_duration)
+           from build_status_log
+           where sysname = ? and snapshot = ?
+        };
+       ($run_time) = $db->selectrow_array($stage_times_query,undef,
+                                  $system,$logdate);
        $db->disconnect;
 }
 
        $db->disconnect;
 }
 
-foreach my $chgd ($changed_this_run,$changed_since_success)
-{
-       my $cvsurl = 'http://anoncvs.postgresql.org/cvsweb.cgi';
-       my $giturl = $scmurl || 'http://git.postgresql.org/gitweb?p=postgresql.git;a=commit;h=';
-    my @lines = split(/!/,$chgd);
-    foreach (@lines)
-    {
-               if ($scm eq 'git')
-               {
-                       s!(^\S+)(\s+)(\S+)!<a href="$giturl$3">$1</a>!;
-               }
-               elsif ($scm eq 'cvs')
-               {
-                       next unless m!^(pgsql|master|REL\d_\d_STABLE)/!;
-                       s!(^\S+)(\s+)(\S+)!<a href="$cvsurl/$1?rev=$3">$1$2$3</a>!;
-               }
-    }
-    $chgd = join("\n",@lines);
-    $chgd ||= 'not recorded';
-       
-}
+my ($changed_this_run_logs, $changed_since_success_logs);
+($changed_this_run, $changed_this_run_logs) = 
+  process_changed($changed_this_run,
+                                 $git_head_ref,$last_build_git_ref);
+($changed_since_success, $changed_since_success_logs) = 
+  process_changed($changed_since_success,
+                                 $last_build_git_ref,$last_success_git_ref);
 
 $conf =~ s/\@/ [ a t ] /g;
 
 $conf =~ s/\@/ [ a t ] /g;
-map {s/&/&amp;/g; s/</&lt;/g; s/>/&gt;/g; s/\"/&quot;/g;} ($log,$conf);
-# map {s/!/\n/g} ($changed_this_run,$changed_since_success);
-
-
-use POSIX qw(ceil);
-my $lrfactor = 6;
-my $logrows = ceil(scalar(@log_file_names)/$lrfactor);
-my $logcells = $lrfactor * $logrows;
-
-my $heading_done;
-my $urldt = uri_escape($logdate);
-
-my $cell = 0;
-
-
 
 print "Content-Type: text/html\n\n";
 
 
 print "Content-Type: text/html\n\n";
 
-if ($stage eq 'OK')
-{
-       print <<EOHTML;
-<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
-        "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
-<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
-<head>
-       <meta http-equiv="content-type" content="text/html; charset=utf-8" />
-    <title>PostgreSQL BuildFarm | Configuration summary for system "$system"</title>
-       <link rel="icon" type="image/png" href="/elephant-icon.png" />
-    <link rel="stylesheet" rev="stylesheet" href="/inc/pgbf.css" charset="utf-8" />
-</head>
-<body>
-<div id="wrapper">
-<div id="banner">
-<a href="/index.html"><img src="/inc/pgbuildfarm-banner.png" alt="PostgreSQL BuildFarm" width="800" height="73" /></a>
-<div id="nav">
-<ul>
-    <li id="home"><a href="/index.html" title="PostgreSQL BuildFarm Home">Home</a></li>
-    <li id="status"><a href="/cgi-bin/show_status.pl" title="Current results">Status</a></li>
-    <li id="members"><a href="/cgi-bin/show_members.pl" title="Platforms tested">Members</a></li>
-    <li id="register"><a href="/cgi-bin/register-form.pl" title="Join PostgreSQL BuildFarm">Register</a></li>
-    <li id="pgfoundry"><a href="http://pgfoundry.org/projects/pgbuildfarm/">PGFoundry</a></li>
-</ul>
-</div><!-- nav -->
-</div><!-- banner -->
-<div id="main">
-<h1>PostgreSQL Build Farm Log</h1>
-<table align="top" cellspacing="0">
-    <tr>
-        <th class="head" rowspan="2">System Information</th>
-        <th>Farm member</th>
-        <th>Branch</th>
-        <th>OS</th>
-        <th>Compiler</th>
-        <th>Architecture</th>
-        <th>Owner</th>
-    </tr>
-    <tr>
-        <td>$system</td>
-        <td><a href="/cgi-bin/show_history.pl?nm=$system&amp;br=$branch">$branch</a></td>
-        <td>$info_row->{operating_system} $info_row->{os_version}</td>
-        <td>$info_row->{compiler} $info_row->{compiler_version}</td>
-        <td>$info_row->{architecture}</td>
-        <td>$info_row->{owner_email}</td>
-    </tr>
-    </table>
-EOHTML
-
-    if ($info_row->{sys_notes})
-    {
-        print <<EOHTML;
-    <br />
-    <table>
-     <tr>
-       <th class="head" rowspan="2">System Notes</th>
-       <th>Date</th>
-       <th>Notes</th>
-     </tr>
-     <tr>
-      <td>$info_row->{sys_notes_date}</td>
-      <td>$info_row->{sys_notes}</td>
-     </tr>
-   </table>
-EOHTML
-
-    }
-
-for my $logstage (@log_file_names)
-{
-    print "<br /> <table><tr><th class='head' rowspan='$logrows'>Stage Logs</th>\n"
-       unless $heading_done;
-    $heading_done = 1;
-    $cell++;
-    $logstage =~ s/\.log$//;
-    print "<tr>\n" if ($cell > 1 && $cell % $lrfactor == 1);
-    print "<td><a href='show_stage_log.pl?nm=$system&amp;dt=$urldt&amp;stg=$logstage'>$logstage</a></td>\n";
-    print "</tr>\n" if ($cell % $lrfactor == 0);
-}
-
-if ($cell)
+$template->process('log.tt',
+       {
+               scm => $scm,
+               scmurl => $scmurl,
+               system => $system,
+               branch => $branch,
+               stage => $stage,
+               stage_times => $stage_times,
+               run_time => $run_time,
+               urldt => $logdate,
+               log_file_names => \@log_file_names,
+               conf => $conf,
+               log => $log,
+               changed_this_run => $changed_this_run,
+               changed_since_success => $changed_since_success,
+               changed_this_run_logs => $changed_this_run_logs,
+               changed_since_success_logs => $changed_since_success_logs,
+               info_row => $info_row,
+           git_head_ref => $git_head_ref,
+           last_build_git_ref => $last_build_git_ref,
+           last_success_git_ref => $last_success_git_ref,
+
+       });
+
+exit;
+
+##########################################################
+
+sub process_changed
 {
 {
-    foreach my $rcell ($cell+1 .. $logcells)
-    {
-       print "<tr>\n" if ($rcell > 1 && $rcell % $lrfactor == 1);
-       print "<td>&nbsp;</td>\n";
-       print "</tr>\n" if ($rcell % $lrfactor == 0);
-    }
-    print "</table>\n";
-}
-
-print <<EOHTML;
-</table>
-<h2>Configuration summary for system "$system"</h2>
-<h3>Status 'OK' on snapshot taken $logdate</h3>
-<pre>
-$conf
-</pre>
-<h3>Files changed this run</h3>
-<pre>
-$changed_this_run
-</pre>
-EOHTML
-print <<EOHTML if ($log);
-<h3>Log</h3>
-<pre>
-$log
-</pre>
-EOHTML
-    print <<EOHTML;
-</div><!-- main -->
-<hr />
-<p style="text-align: center;">
-Hosting for the PostgreSQL Buildfarm is generously 
-provided by: 
-<a href="http://www.commandprompt.com">CommandPrompt, 
-The PostgreSQL Company</a>
-</p>
-</div><!-- wrapper -->
-</body>
-</html>
-EOHTML
-;
-
-       exit;
-}
-
-print <<EOHTML;
-<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
-        "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
-<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
-<head>
-       <meta http-equiv="content-type" content="text/html; charset=utf-8" />
-    <title>PostgreSQL BuildFarm | Log for system "$system" failure on snapshot taken $logdate</title>
-    <link rel="stylesheet" rev="stylesheet" href="/inc/pgbf.css" charset="utf-8" />
-</head>
-<body>
-<div id="wrapper">
-<div id="banner">
-<a href="/index.html"><img src="/inc/pgbuildfarm-banner.png" alt="PostgreSQL BuildFarm" width="800" height="73" /></a>
-<div id="nav">
-<ul>
-    <li id="home"><a href="/index.html" title="PostgreSQL BuildFarm Home">Home</a></li>
-    <li id="status"><a href="/cgi-bin/show_status.pl" title="Status Page">Status</a></li>
-    <li id="members"><a href="/cgi-bin/show_members.pl" title="Status Page">Members</a></li>
-    <li id="register"><a href="/cgi-bin/register-form.pl" title="Register">Register</a></li>
-    <li id="pgfoundry"><a href="http://pgfoundry.org/projects/pgbuildfarm/">PGFoundry</a></li>
-</ul>
-</div><!-- nav -->
-</div><!-- banner -->
-<div id="main">
-    <h1>PostgreSQL Build Farm Log</h1>
-<h1>Details for system "$system" failure at stage $stage on snapshot taken $logdate</h1>
-<table cellspacing="0">
-    <tr>
-        <th class="head" rowspan="2">System Information</th>
-        <th>Farm member</th>
-        <th>Branch</th>
-        <th>OS</th>
-        <th>Compiler</th>
-        <th>Architecture</th>
-        <th>Owner</th>
-    </tr>
-    <tr>
-        <td>$system</td>
-        <td><a href="/cgi-bin/show_history.pl?nm=$system&amp;br=$branch">$branch</a></td>
-        <td>$info_row->{operating_system} $info_row->{os_version}</td>
-        <td>$info_row->{compiler} $info_row->{compiler_version}</td>
-        <td>$info_row->{architecture}</td>
-        <td>$info_row->{owner_email}</td>
-    </tr>
-  </table>
-EOHTML
-
-    if ($info_row->{sys_notes})
-    {
-        print <<EOHTML;
-    <br />
-    <table>
-     <tr>
-       <th class="head" rowspan="2">System Notes</th>
-       <th>Date</th>
-       <th>Notes</th>
-     </tr>
-     <tr>
-      <td>$info_row->{sys_notes_date}</td>
-      <td>$info_row->{sys_notes}</td>
-     </tr>
-   </table>
-EOHTML
 
 
-    }
-
-for my $logstage (@log_file_names)
-{
-    print "<br /> <table><tr><th class='head' rowspan='4'>Stage Logs</th>\n"
-       unless $heading_done;
-    $heading_done = 1;
-    $cell++;
-    $logstage =~ s/\.log$//;
-    print "<tr>\n" if ($cell > 1 && $cell % $lrfactor == 1);
-    print "<td><a href='show_stage_log.pl?nm=$system&amp;dt=$urldt&amp;stg=$logstage'>$logstage</a></td>\n";
-    print "</tr>\n" if ($cell % $lrfactor == 0);
-}
+       my $chgd = shift;
+       my $git_to = shift;
+       my $git_from = shift;
 
 
-if ($cell)
-{
-    foreach my $rcell ($cell+1 .. $logcells)
+    my @lines = split(/!/,$chgd);
+    my @changed_rows;
+       my %commits;
+       my @commit_logs;
+       my $gitcmd = "TZ=UTC GIT_DIR=$local_git_clone git log --date=local";
+    foreach (@lines)
     {
     {
-       print "<tr>\n" if ($rcell > 1 && $rcell % $lrfactor == 1);
-       print "<td>&nbsp;</td>\n";
-       print "</tr>\n" if ($rcell % $lrfactor == 0);
+               next if ($scm eq 'cvs' and ! m!^(pgsql|master|REL\d_\d_STABLE)/!);
+               push(@changed_rows,[$1,$3]) if (m!(^\S+)(\s+)(\S+)!);
+               $commits{$3} = 1 if $scm eq 'git';
     }
     }
-    print "</table>\n";
+       if ($git_from && $git_to)
+       {
+               my $format = 'commit %h %cd UTC%w(160,2,2)%s';
+               my $gitlog = `$gitcmd --pretty=format:"$format" $git_from..$git_to 2>&1`;
+               @commit_logs = split(/(?=^commit)/m,$gitlog)
+       }
+       else
+       {
+               # normally we expect to have the git refs. this is just a fallback.
+               my $format = 'epoch: %at%ncommit %h %cd UTC%w(160,2,2)%s';
+               foreach my $commit ( keys %commits )
+               {
+                       my $commitlog = 
+                         `$gitcmd -n 1 --pretty=format:"$format" $commit 2>&1`;
+                       push(@commit_logs,$commitlog);
+               }
+               @commit_logs = reverse (sort @commit_logs);
+               s/epoch:.*\n// for (@commit_logs);
+       }
+               return (\@changed_rows,\@commit_logs);
 }
 }
-
-print <<EOHTML;
-<h3>Configuration summary</h3>
-<pre>
-$conf
-</pre>
-<h3>Files changed this run</h3>
-<pre>
-$changed_this_run
-</pre>
-<h3>Files changed since last success</h3>
-<pre>
-$changed_since_success
-</pre>
-<h3>Log</h3>
-<pre>
-$log
-</pre>
-</div><!-- main -->
-<hr />
-<p style="text-align: center;">
-Hosting for the PostgreSQL Buildfarm is generously 
-provided by: 
-<a href="http://www.commandprompt.com">CommandPrompt, 
-The PostgreSQL Company</a>
-</p>
-</div><!-- wrapper -->
-</body>
-</html>
-EOHTML
-;
-
-
-
-
Server side for Exim Build Farm