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 my ($stage_times, $run_time);
  42
  43 use vars qw($info_row);
  44
  45 if ($system && $logdate)
  46 {
  47
  48         my $db = DBI->connect($dsn,$dbuser,$dbpass,{pg_expand_array => 0});
  49
  50         die $DBI::errstr unless $db;
  51
  52         my $statement = q{
  53
  54                 select log,conf_sum,stage, changed_this_run, changed_since_success,
  55                 branch, log_archive_filenames, scm, scmurl, git_head_ref
  56                 from build_status
  57                 where sysname = ? and snapshot = ?
  58
  59         };
  60         my $last_build_statement = q{
  61                 select git_head_ref
  62                 from build_status
  63                 where sysname = ? and branch = ?  and snapshot =
  64                     (select max(snapshot)
  65                     from build_status
  66                     where sysname = ? and branch = ? and snapshot < ?)
  67         };
  68         my $last_success_statement = q{
  69                 select git_head_ref
  70                 from build_status
  71                 where sysname = ? and branch = ?  and snapshot =
  72                     (select max(snapshot)
  73                     from build_status
  74                     where sysname = ? and branch = ? and snapshot < ? and stage = 'OK')
  75         };
  76         my $sth=$db->prepare($statement);
  77         $sth->execute($system,$logdate);
  78         my $row=$sth->fetchrow_arrayref;
  79         $branch = $row->[5];
  80         $git_head_ref = $row->[9];
  81         $sth->finish;
  82         my $last_build_row;
  83         if ($git_head_ref)
  84         {
  85                 $last_build_row =
  86                   $db->selectrow_hashref($last_build_statement,undef,
  87                                                                  $system, $branch,$system,$branch,$logdate);
  88                 $last_build_git_ref = $last_build_row->{git_head_ref}
  89                   if $last_build_row;
  90
  91         }
  92         my $last_success_row;
  93         if (ref $last_build_row && $last_build_row->{stage} ne 'OK')
  94         {
  95                 $last_success_row =
  96                   $db->selectrow_hashref($last_success_statement,undef,
  97                                                                  $system,$branch,$system,$branch,$logdate);
  98                 $last_success_git_ref = $last_success_row->{git_head_ref}
  99                   if $last_success_row;
 100         }
 101         $log=$row->[0];
 102         $conf=$row->[1] || "not recorded" ;
 103         $stage=$row->[2] || "unknown";
 104         $changed_this_run = $row->[3];
 105         $changed_since_success = $row->[4];
 106         my $log_file_names = $row->[6];
 107         $scm = $row->[7];
 108         $scm ||= 'cvs'; # legacy scripts
 109         $scmurl = $row->[8];
 110         $scmurl = undef unless $scmurl =~ /^http/; # slight sanity check
 111         $scmurl = 'http://git.postgresql.org/gitweb?p=postgresql.git;a=commit;h='
 112             if ($scmurl eq 'http://git.postgresql.org/git/postgresql.git');
 113         $log_file_names =~ s/^\{(.*)\}$/$1/;
 114         @log_file_names=split(',',$log_file_names)
 115             if $log_file_names;
 116
 117         $statement = q{
 118
 119           select operating_system, os_version,
 120                  compiler, compiler_version,
 121                  architecture,
 122                  replace(owner_email,E'\@',' [ a t ] ') as owner_email,
 123                  sys_notes_ts::date AS sys_notes_date, sys_notes
 124           from buildsystems
 125           where status = 'approved'
 126                 and name = ?
 127
 128         };
 129         $sth=$db->prepare($statement);
 130         $sth->execute($system);
 131         $info_row=$sth->fetchrow_hashref;
 132
 133         my $latest_personality = $db->selectrow_arrayref(q{
 134             select os_version, compiler_version
 135             from personality
 136             where effective_date < ?
 137             and name = ?
 138             order by effective_date desc limit 1
 139         }, undef, $logdate, $system);
 140         if ($latest_personality)
 141         {
 142             $info_row->{os_version} = $latest_personality->[0];
 143             $info_row->{compiler_version} = $latest_personality->[1];
 144         }
 145         $sth->finish;
 146         my $stage_times_query = q{
 147            select log_stage, stage_duration
 148            from build_status_log
 149            where sysname = ? and snapshot = ?
 150         };
 151         $stage_times =
 152             $db->selectall_hashref($stage_times_query,'log_stage',undef,
 153                                    $system,$logdate);
 154         $stage_times_query = q{
 155            select sum(stage_duration)
 156            from build_status_log
 157            where sysname = ? and snapshot = ?
 158         };
 159         ($run_time) = $db->selectrow_array($stage_times_query,undef,
 160                                    $system,$logdate);
 161         $db->disconnect;
 162 }
 163
 164 my ($changed_this_run_logs, $changed_since_success_logs);
 165 ($changed_this_run, $changed_this_run_logs) =
 166   process_changed($changed_this_run,
 167                                   $git_head_ref,$last_build_git_ref);
 168 ($changed_since_success, $changed_since_success_logs) =
 169   process_changed($changed_since_success,
 170                                   $last_build_git_ref,$last_success_git_ref);
 171
 172 $conf =~ s/\@/ [ a t ] /g;
 173
 174 print "Content-Type: text/html\n\n";
 175
 176 $template->process('log.tt',
 177         {
 178                 scm => $scm,
 179                 scmurl => $scmurl,
 180                 system => $system,
 181                 branch => $branch,
 182                 stage => $stage,
 183                 stage_times => $stage_times,
 184                 run_time => $run_time,
 185                 urldt => $logdate,
 186                 log_file_names => \@log_file_names,
 187                 conf => $conf,
 188                 log => $log,
 189                 changed_this_run => $changed_this_run,
 190                 changed_since_success => $changed_since_success,
 191                 changed_this_run_logs => $changed_this_run_logs,
 192                 changed_since_success_logs => $changed_since_success_logs,
 193                 info_row => $info_row,
 194             git_head_ref => $git_head_ref,
 195             last_build_git_ref => $last_build_git_ref,
 196             last_success_git_ref => $last_success_git_ref,
 197
 198         });
 199
 200 exit;
 201
 202 ##########################################################
 203
 204 sub process_changed
 205 {
 206
 207         my $chgd = shift;
 208         my $git_to = shift;
 209         my $git_from = shift;
 210
 211     my @lines = split(/!/,$chgd);
 212     my @changed_rows;
 213         my %commits;
 214         my @commit_logs;
 215         my $gitcmd = "TZ=UTC GIT_DIR=$local_git_clone git log --date=local";
 216     foreach (@lines)
 217     {
 218                 next if ($scm eq 'cvs' and ! m!^(pgsql|master|REL\d_\d_STABLE)/!);
 219                 push(@changed_rows,[$1,$3]) if (m!(^\S+)(\s+)(\S+)!);
 220                 $commits{$3} = 1 if $scm eq 'git';
 221     }
 222         if ($git_from && $git_to)
 223         {
 224                 my $format = 'commit %h %cd UTC%w(160,2,2)%s';
 225                 my $gitlog = `$gitcmd --pretty=format:"$format" $git_from..$git_to 2>&1`;
 226                 @commit_logs = split(/(?=^commit)/m,$gitlog)
 227         }
 228         else
 229         {
 230                 # normally we expect to have the git refs. this is just a fallback.
 231                 my $format = 'epoch: %at%ncommit %h %cd UTC%w(160,2,2)%s';
 232                 foreach my $commit ( keys %commits )
 233                 {
 234                         my $commitlog =
 235                           `$gitcmd -n 1 --pretty=format:"$format" $commit 2>&1`;
 236                         push(@commit_logs,$commitlog);
 237                 }
 238                 @commit_logs = reverse (sort @commit_logs);
 239                 s/epoch:.*\n// for (@commit_logs);
 240         }
 241                 return (\@changed_rows,\@commit_logs);
 242 }
 243