5 Copyright (c) 2003-2010, Andrew Dunstan
7 See accompanying License file for license details
16 use vars qw($dbhost $dbname $dbuser $dbpass $dbport
17 $template_dir @log_file_names $local_git_clone);
19 use FindBin qw($RealBin);
20 require "$RealBin/../BuildFarmWeb.pl";
22 my $template_opts = { INCLUDE_PATH => $template_dir, EVAL_PERL => 1};
23 my $template = new Template($template_opts);
25 die "no dbname" unless $dbname;
26 die "no dbuser" unless $dbuser;
28 my $dsn="dbi:Pg:dbname=$dbname";
29 $dsn .= ";host=$dbhost" if $dbhost;
30 $dsn .= ";port=$dbport" if $dbport;
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;
39 my ($stage,$changed_this_run,$changed_since_success,$sysinfo,$branch,$scmurl);
41 my ($git_head_ref, $last_build_git_ref, $last_success_git_ref);
42 my ($stage_times, $run_time);
44 use vars qw($info_row);
46 if ($system && $logdate)
49 my $db = DBI->connect($dsn,$dbuser,$dbpass,{pg_expand_array => 0});
51 die $DBI::errstr unless $db;
55 select log,conf_sum,stage, changed_this_run, changed_since_success,
56 branch, log_archive_filenames, scm, scmurl, git_head_ref
58 where sysname = ? and snapshot = ?
61 my $last_build_statement = q{
64 where sysname = ? and branch = ? and snapshot =
67 where sysname = ? and branch = ? and snapshot < ?)
69 my $last_success_statement = q{
72 where sysname = ? and branch = ? and snapshot =
75 where sysname = ? and branch = ? and snapshot < ? and stage = 'OK')
77 my $sth=$db->prepare($statement);
78 $sth->execute($system,$logdate);
79 my $row=$sth->fetchrow_arrayref;
81 $git_head_ref = $row->[9];
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}
94 if (ref $last_build_row && $last_build_row->{stage} ne 'OK')
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;
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];
109 $scm ||= 'cvs'; # legacy scripts
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)
120 select operating_system, os_version,
121 compiler, compiler_version,
123 replace(owner_email,E'\@',' [ a t ] ') as owner_email,
124 sys_notes_ts::date AS sys_notes_date, sys_notes
126 where status = 'approved'
130 $sth=$db->prepare($statement);
131 $sth->execute($system);
132 $info_row=$sth->fetchrow_hashref;
134 my $latest_personality = $db->selectrow_arrayref(q{
135 select os_version, compiler_version
137 where effective_date < ?
139 order by effective_date desc limit 1
140 }, undef, $logdate, $system);
141 if ($latest_personality)
143 $info_row->{os_version} = $latest_personality->[0];
144 $info_row->{compiler_version} = $latest_personality->[1];
147 my $stage_times_query = q{
148 select log_stage, stage_duration
149 from build_status_log
150 where sysname = ? and snapshot = ?
153 $db->selectall_hashref($stage_times_query,'log_stage',undef,
155 $stage_times_query = q{
156 select sum(stage_duration)
157 from build_status_log
158 where sysname = ? and snapshot = ?
160 ($run_time) = $db->selectrow_array($stage_times_query,undef,
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);
173 $conf =~ s/\@/ [ a t ] /g;
175 print "Content-Type: text/html\n\n";
177 $template->process('log.tt',
184 stage_times => $stage_times,
185 run_time => $run_time,
187 log_file_names => \@log_file_names,
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,
203 ##########################################################
210 my $git_from = shift;
212 my @lines = split(/!/,$chgd);
216 my $gitcmd = "TZ=UTC GIT_DIR=$local_git_clone git log --date=local";
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';
223 if ($git_from && $git_to)
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)
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 )
236 `$gitcmd -n 1 --pretty=format:"$format" $commit 2>&1`;
237 push(@commit_logs,$commitlog);
239 @commit_logs = reverse (sort @commit_logs);
240 s/epoch:.*\n// for (@commit_logs);
242 return (\@changed_rows,\@commit_logs);