22df73144db1911a26970c8ccdc73c440fe3c274
[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 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 = 'http://git.postgresql.org/gitweb?p=postgresql.git;a=commit;h=' 
111             if ($scmurl eq 'http://git.postgresql.org/git/postgresql.git');
112         $log_file_names =~ s/^\{(.*)\}$/$1/;
113         @log_file_names=split(',',$log_file_names)
114             if $log_file_names;
115
116         $statement = q{
117
118           select operating_system, os_version, 
119                  compiler, compiler_version, 
120                  architecture,
121                  replace(owner_email,E'\@',' [ a t ] ') as owner_email,
122                  sys_notes_ts::date AS sys_notes_date, sys_notes
123           from buildsystems 
124           where status = 'approved'
125                 and name = ?
126
127         };
128         $sth=$db->prepare($statement);
129         $sth->execute($system);
130         $info_row=$sth->fetchrow_hashref;
131
132         my $latest_personality = $db->selectrow_arrayref(q{
133             select os_version, compiler_version
134             from personality
135             where effective_date < ?
136             and name = ?
137             order by effective_date desc limit 1
138         }, undef, $logdate, $system);
139         if ($latest_personality)
140         {
141             $info_row->{os_version} = $latest_personality->[0];
142             $info_row->{compiler_version} = $latest_personality->[1];
143         }
144         $sth->finish;
145         my $stage_times_query = q{
146            select log_stage, stage_duration
147            from build_status_log
148            where sysname = ? and snapshot = ?
149         };
150         $stage_times = 
151             $db->selectall_hashref($stage_times_query,'log_stage',undef,
152                                    $system,$logdate);
153         $stage_times_query = q{
154            select sum(stage_duration)
155            from build_status_log
156            where sysname = ? and snapshot = ?
157         };
158         ($run_time) = $db->selectrow_array($stage_times_query,undef,
159                                    $system,$logdate);
160         $db->disconnect;
161 }
162
163 my ($changed_this_run_logs, $changed_since_success_logs);
164 ($changed_this_run, $changed_this_run_logs) = 
165   process_changed($changed_this_run,
166                                   $git_head_ref,$last_build_git_ref);
167 ($changed_since_success, $changed_since_success_logs) = 
168   process_changed($changed_since_success,
169                                   $last_build_git_ref,$last_success_git_ref);
170
171 $conf =~ s/\@/ [ a t ] /g;
172
173 print "Content-Type: text/html\n\n";
174
175 $template->process('log.tt',
176         {
177                 scm => $scm,
178                 scmurl => $scmurl,
179                 system => $system,
180                 branch => $branch,
181                 stage => $stage,
182                 stage_times => $stage_times,
183                 run_time => $run_time,
184                 urldt => $logdate,
185                 log_file_names => \@log_file_names,
186                 conf => $conf,
187                 log => $log,
188                 changed_this_run => $changed_this_run,
189                 changed_since_success => $changed_since_success,
190                 changed_this_run_logs => $changed_this_run_logs,
191                 changed_since_success_logs => $changed_since_success_logs,
192                 info_row => $info_row,
193             git_head_ref => $git_head_ref,
194             last_build_git_ref => $last_build_git_ref,
195             last_success_git_ref => $last_success_git_ref,
196
197         });
198
199 exit;
200
201 ##########################################################
202
203 sub process_changed
204 {
205
206         my $chgd = shift;
207         my $git_to = shift;
208         my $git_from = shift;
209
210     my @lines = split(/!/,$chgd);
211     my @changed_rows;
212         my %commits;
213         my @commit_logs;
214         my $gitcmd = "TZ=UTC GIT_DIR=$local_git_clone git log --date=local";
215     foreach (@lines)
216     {
217                 next if ($scm eq 'cvs' and ! m!^(pgsql|master|REL\d_\d_STABLE)/!);
218                 push(@changed_rows,[$1,$3]) if (m!(^\S+)(\s+)(\S+)!);
219                 $commits{$3} = 1 if $scm eq 'git';
220     }
221         if ($git_from && $git_to)
222         {
223                 my $format = 'commit %h %cd UTC%w(160,2,2)%s';
224                 my $gitlog = `$gitcmd --pretty=format:"$format" $git_from..$git_to 2>&1`;
225                 @commit_logs = split(/(?=^commit)/m,$gitlog)
226         }
227         else
228         {
229                 # normally we expect to have the git refs. this is just a fallback.
230                 my $format = 'epoch: %at%ncommit %h %cd UTC%w(160,2,2)%s';
231                 foreach my $commit ( keys %commits )
232                 {
233                         my $commitlog = 
234                           `$gitcmd -n 1 --pretty=format:"$format" $commit 2>&1`;
235                         push(@commit_logs,$commitlog);
236                 }
237                 @commit_logs = reverse (sort @commit_logs);
238                 s/epoch:.*\n// for (@commit_logs);
239         }
240                 return (\@changed_rows,\@commit_logs);
241 }
242