trunk/cgi-bin/show_log.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use DBI;
   5 use Template;
   6 use CGI;
   7
   8 use vars qw($dbhost $dbname $dbuser $dbpass $dbport $template_dir @log_file_names);
   9
  10 require "$ENV{BFConfDir}/BuildFarmWeb.pl";
  11
  12 my $template_opts = { INCLUDE_PATH => $template_dir, EVAL_PERL => 1};
  13 my $template = new Template($template_opts);
  14
  15 die "no dbname" unless $dbname;
  16 die "no dbuser" unless $dbuser;
  17
  18 my $dsn="dbi:Pg:dbname=$dbname";
  19 $dsn .= ";host=$dbhost" if $dbhost;
  20 $dsn .= ";port=$dbport" if $dbport;
  21
  22 my $query = new CGI;
  23
  24 my $system = $query->param('nm'); $system =~ s/[^a-zA-Z0-9_ -]//g;
  25 my $logdate = $query->param('dt'); $logdate =~ s/[^a-zA-Z0-9_ :-]//g;
  26
  27 my $log = "";
  28 my $conf = "";
  29 my ($stage,$changed_this_run,$changed_since_success,$sysinfo,$branch,$scmurl);
  30 my $scm;
  31
  32 use vars qw($info_row);
  33
  34 if ($system && $logdate)
  35 {
  36
  37         my $db = DBI->connect($dsn,$dbuser,$dbpass,{pg_expand_array => 0});
  38
  39         die $DBI::errstr unless $db;
  40
  41         my $statement = q{
  42
  43                 select log,conf_sum,stage, changed_this_run, changed_since_success,branch,
  44                         log_archive_filenames, scm, scmurl
  45                 from build_status
  46                 where sysname = ? and snapshot = ?
  47
  48         };
  49         my $sth=$db->prepare($statement);
  50         $sth->execute($system,$logdate);
  51         my $row=$sth->fetchrow_arrayref;
  52         $log=$row->[0];
  53         $conf=$row->[1] || "not recorded" ;
  54         $stage=$row->[2] || "unknown";
  55         $changed_this_run = $row->[3];
  56         $changed_since_success = $row->[4];
  57         $branch = $row->[5];
  58         my $log_file_names = $row->[6];
  59         $scm = $row->[7];
  60         $scm ||= 'cvs'; # legacy scripts
  61         $scmurl = $row->[8];
  62         $log_file_names =~ s/^\{(.*)\}$/$1/;
  63         @log_file_names=split(',',$log_file_names)
  64             if $log_file_names;
  65         $sth->finish;
  66
  67         $statement = q{
  68
  69           select operating_system, os_version,
  70                  compiler, compiler_version,
  71                  architecture,
  72                  replace(owner_email,'\@',' [ a t ] ') as owner_email,
  73                  sys_notes_ts::date AS sys_notes_date, sys_notes
  74           from buildsystems
  75           where status = 'approved'
  76                 and name = ?
  77
  78         };
  79         $sth=$db->prepare($statement);
  80         $sth->execute($system);
  81         $info_row=$sth->fetchrow_hashref;
  82
  83         my $latest_personality = $db->selectrow_arrayref(q{
  84             select os_version, compiler_version
  85             from personality
  86             where effective_date < ?
  87             and name = ?
  88             order by effective_date desc limit 1
  89         }, undef, $logdate, $system);
  90         # $sysinfo = join(" ",@$row);
  91         if ($latest_personality)
  92         {
  93             $info_row->{os_version} = $latest_personality->[0];
  94             $info_row->{compiler_version} = $latest_personality->[1];
  95         }
  96         $sth->finish;
  97         $db->disconnect;
  98 }
  99
 100 foreach my $chgd ($changed_this_run,$changed_since_success)
 101 {
 102         my $cvsurl = 'http://anoncvs.postgresql.org/cvsweb.cgi';
 103         my $giturl = $scmurl || 'http://git.postgresql.org/gitweb?p=postgresql.git;a=commit;h=';
 104     my @lines = split(/!/,$chgd);
 105     my $changed_rows = [];
 106     foreach (@lines)
 107     {
 108         next if ($scm eq 'cvs' and ! m!^(pgsql|master|REL\d_\d_STABLE)/!);
 109         push(@$changed_rows,[$1,$3]) if (m!(^\S+)(\s+)(\S+)!);
 110     }
 111     $chgd = $changed_rows;
 112 }
 113
 114 $conf =~ s/\@/ [ a t ] /g;
 115
 116 print "Content-Type: text/html\n\n";
 117
 118 $template->process('log.tt',
 119         {
 120                 scm => $scm,
 121                 scmurl => $scmurl,
 122                 system => $system,
 123                 branch => $branch,
 124                 stage => $stage,
 125                 urldt => $logdate,
 126                 log_file_names => \@log_file_names,
 127                 conf => $conf,
 128                 log => $log,
 129                 changed_this_run => $changed_this_run,
 130                 changed_since_success => $changed_since_success,
 131                 info_row => $info_row,
 132
 133         });
 134