turn off perl expansion of postgres arrays
[buildfarm-server.git] / 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