cgi-bin/show_log.pl

   1 #!/usr/bin/perl
   2
   3 =comment
   4
   5 Copyright (c) 2003-2010, Andrew Dunstan
   6
   7 See accompanying License file for license details
   8
   9 =cut
  10
  11 use strict;
  12 use DBI;
  13 use Template;
  14 use CGI;
  15
  16 use vars qw($dbhost $dbname $dbuser $dbpass $dbport
  17                         $template_dir @log_file_names $local_git_clone);
  18
  19 require "$ENV{BFConfDir}/BuildFarmWeb.pl";
  20
  21 my $template_opts = { INCLUDE_PATH => $template_dir, EVAL_PERL => 1};
  22 my $template = new Template($template_opts);
  23
  24 die "no dbname" unless $dbname;
  25 die "no dbuser" unless $dbuser;
  26
  27 my $dsn="dbi:Pg:dbname=$dbname";
  28 $dsn .= ";host=$dbhost" if $dbhost;
  29 $dsn .= ";port=$dbport" if $dbport;
  30
  31 my $query = new CGI;
  32
  33 my $system = $query->param('nm'); $system =~ s/[^a-zA-Z0-9_ -]//g;
  34 my $logdate = $query->param('dt'); $logdate =~ s/[^a-zA-Z0-9_ :-]//g;
  35
  36 my $log = "";
  37 my $conf = "";
  38 my ($stage,$changed_this_run,$changed_since_success,$sysinfo,$branch,$scmurl);
  39 my $scm;
  40 my ($git_head_ref, $last_build_git_ref, $last_success_git_ref);
  41
  42 use vars qw($info_row);
  43
  44 if ($system && $logdate)
  45 {
  46
  47         my $db = DBI->connect($dsn,$dbuser,$dbpass,{pg_expand_array => 0});
  48
  49         die $DBI::errstr unless $db;
  50
  51         my $statement = q{
  52
  53                 select log,conf_sum,stage, changed_this_run, changed_since_success,
  54                 branch, log_archive_filenames, scm, scmurl, git_head_ref
  55                 from build_status
  56                 where sysname = ? and snapshot = ?
  57
  58         };
  59         my $last_build_statement = q{
  60                 select distinct on (sysname) sysname, snapshot, stage, git_head_ref
  61         from build_status
  62         where sysname = ? and snapshot < ?
  63         order by sysname, snapshot desc limit 1
  64         };
  65         my $last_success_statement = q{
  66                 select distinct on (sysname) sysname, snapshot, git_head_ref
  67         from build_status
  68         where sysname = ? and snapshot < ? and stage = 'OK'
  69         order by sysname, snapshot desc limit 1
  70         };
  71         my $sth=$db->prepare($statement);
  72         $sth->execute($system,$logdate);
  73         my $row=$sth->fetchrow_arrayref;
  74         $sth->finish;
  75         $git_head_ref = $row->[9];
  76         my $last_build_row;
  77         if ($git_head_ref)
  78         {
  79                 $last_build_row =
  80                   $db->selectrow_hashref($last_build_statement,undef,
  81                                                                  $system,$logdate);
  82                 $last_build_git_ref = $last_build_row->{git_head_ref}
  83                   if $last_build_row;
  84
  85         }
  86         my $last_success_row;
  87         if (ref $last_build_row && $last_build_row->{stage} ne 'OK')
  88         {
  89                 $last_success_row =
  90                   $db->selectrow_hashref($last_success_statement,undef,
  91                                                                  $system,$logdate);
  92                 $last_success_git_ref = $last_success_row->{git_head_ref}
  93                   if $last_success_row;
  94         }
  95         $log=$row->[0];
  96         $conf=$row->[1] || "not recorded" ;
  97         $stage=$row->[2] || "unknown";
  98         $changed_this_run = $row->[3];
  99         $changed_since_success = $row->[4];
 100         $branch = $row->[5];
 101         my $log_file_names = $row->[6];
 102         $scm = $row->[7];
 103         $scm ||= 'cvs'; # legacy scripts
 104         $scmurl = $row->[8];
 105         $log_file_names =~ s/^\{(.*)\}$/$1/;
 106         @log_file_names=split(',',$log_file_names)
 107             if $log_file_names;
 108
 109         $statement = q{
 110
 111           select operating_system, os_version,
 112                  compiler, compiler_version,
 113                  architecture,
 114                  replace(owner_email,'\@',' [ a t ] ') as owner_email,
 115                  sys_notes_ts::date AS sys_notes_date, sys_notes
 116           from buildsystems
 117           where status = 'approved'
 118                 and name = ?
 119
 120         };
 121         $sth=$db->prepare($statement);
 122         $sth->execute($system);
 123         $info_row=$sth->fetchrow_hashref;
 124
 125         my $latest_personality = $db->selectrow_arrayref(q{
 126             select os_version, compiler_version
 127             from personality
 128             where effective_date < ?
 129             and name = ?
 130             order by effective_date desc limit 1
 131         }, undef, $logdate, $system);
 132         if ($latest_personality)
 133         {
 134             $info_row->{os_version} = $latest_personality->[0];
 135             $info_row->{compiler_version} = $latest_personality->[1];
 136         }
 137         $sth->finish;
 138         $db->disconnect;
 139 }
 140
 141 my ($changed_this_run_logs, $changed_since_success_logs);
 142 ($changed_this_run, $changed_this_run_logs) =
 143   process_changed($changed_this_run,
 144                                   $git_head_ref,$last_build_git_ref);
 145 ($changed_since_success, $changed_since_success_logs) =
 146   process_changed($changed_since_success,
 147                                   $last_build_git_ref,$last_success_git_ref);
 148
 149 $conf =~ s/\@/ [ a t ] /g;
 150
 151 print "Content-Type: text/html\n\n";
 152
 153 $template->process('log.tt',
 154         {
 155                 scm => $scm,
 156                 scmurl => $scmurl,
 157                 system => $system,
 158                 branch => $branch,
 159                 stage => $stage,
 160                 urldt => $logdate,
 161                 log_file_names => \@log_file_names,
 162                 conf => $conf,
 163                 log => $log,
 164                 changed_this_run => $changed_this_run,
 165                 changed_since_success => $changed_since_success,
 166                 changed_this_run_logs => $changed_this_run_logs,
 167                 changed_since_success_logs => $changed_since_success_logs,
 168                 info_row => $info_row,
 169             git_head_ref => $git_head_ref,
 170             last_build_git_ref => $last_build_git_ref,
 171             last_success_git_ref => $last_success_git_ref,
 172
 173         });
 174
 175 exit;
 176
 177 ##########################################################
 178
 179 sub process_changed
 180 {
 181
 182         my $chgd = shift;
 183         my $git_to = shift;
 184         my $git_from = shift;
 185
 186     my @lines = split(/!/,$chgd);
 187     my @changed_rows;
 188         my %commits;
 189         my @commit_logs;
 190         my $gitcmd = "TZ=UTC GIT_DIR=$local_git_clone git log --stat --date=local";
 191     foreach (@lines)
 192     {
 193                 next if ($scm eq 'cvs' and ! m!^(pgsql|master|REL\d_\d_STABLE)/!);
 194                 push(@changed_rows,[$1,$3]) if (m!(^\S+)(\s+)(\S+)!);
 195                 $commits{$3} = 1 if $scm eq 'git';
 196     }
 197         if ($git_from && $git_to)
 198         {
 199                 my $format =
 200                   'commit %H%nAuthor: %cN <%ce>%nDate: %cd UTC%n%n%w(80,4,4)%s%n%n%b%n';
 201                 my $gitlog = `$gitcmd --pretty=format:"$format" $git_from..$git_to 2>&1`;
 202                 @commit_logs = split(/(?=^commit)/m,$gitlog)
 203         }
 204         else
 205         {
 206                 # normally we expect to have the git refs. this is just a fallback.
 207                 my $format =
 208                   'epoch: %at%ncommit %H%nAuthor: %cN <%ce>%nDate: %cd UTC%n%n' .
 209                         '%w(80,4,4)%s%n%n%b%n';
 210                 foreach my $commit ( keys %commits )
 211                 {
 212                         my $commitlog =
 213                           `$gitcmd -n 1 --pretty=format:"$format" $commit 2>&1`;
 214                         push(@commit_logs,$commitlog);
 215                 }
 216                 @commit_logs = reverse (sort @commit_logs);
 217                 s/epoch:.*\n// for (@commit_logs);
 218         }
 219                 return (\@changed_rows,\@commit_logs);
 220 }
 221