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);
  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         # $sysinfo = join(" ",@$row);
  83         $sth->finish;
  84         $db->disconnect;
  85 }
  86
  87 foreach my $chgd ($changed_this_run,$changed_since_success)
  88 {
  89         my $cvsurl = 'http://anoncvs.postgresql.org/cvsweb.cgi';
  90         my $giturl = $scmurl || 'http://git.postgresql.org/gitweb?p=postgresql.git;a=commit;h=';
  91     my @lines = split(/!/,$chgd);
  92     my $changed_rows = [];
  93     foreach (@lines)
  94     {
  95         next if ($scm eq 'cvs' and ! m!^(pgsql|master|REL\d_\d_STABLE)/!);
  96         push(@$changed_rows,[$1,$3]) if (m!(^\S+)(\s+)(\S+)!);
  97     }
  98     $chgd = $changed_rows;
  99 }
 100
 101 $conf =~ s/\@/ [ a t ] /g;
 102
 103 print "Content-Type: text/html\n\n";
 104
 105 $template->process('log.tt',
 106         {
 107                 scm => $scm,
 108                 scmurl => $scmurl,
 109                 system => $system,
 110                 branch => $branch,
 111                 stage => $stage,
 112                 urldt => $logdate,
 113                 log_file_names => \@log_file_names,
 114                 conf => $conf,
 115                 log => $log,
 116                 changed_this_run => $changed_this_run,
 117                 changed_since_success => $changed_since_success,
 118                 info_row => $info_row,
 119
 120         });
 121