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