Compact git logs and provide changeset links to github.
[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
42 use vars qw($info_row);
43
44 if ($system && $logdate)
45 {
46
47         my $db = DBI->connect($dsn,$dbuser,$dbpass,{pg_expand_array => 0});
48
49         die $DBI::errstr unless $db;
50
51         my $statement = q{
52
53                 select log,conf_sum,stage, changed_this_run, changed_since_success,
54                 branch, log_archive_filenames, scm, scmurl, git_head_ref
55                 from build_status
56                 where sysname = ? and snapshot = ?
57
58         };
59         my $last_build_statement = q{
60                 select distinct on (sysname) sysname, snapshot, stage, git_head_ref 
61         from build_status 
62         where sysname = ? and branch = ? and snapshot < ? 
63         order by sysname, snapshot desc limit 1
64         };
65         my $last_success_statement = q{
66                 select distinct on (sysname) sysname, snapshot, git_head_ref 
67         from build_status 
68         where sysname = ? and branch = ? and snapshot < ? and stage = 'OK' 
69         order by sysname, snapshot desc limit 1
70         };
71         my $sth=$db->prepare($statement);
72         $sth->execute($system,$logdate);
73         my $row=$sth->fetchrow_arrayref;
74         $branch = $row->[5];
75         $git_head_ref = $row->[9];
76         $sth->finish;
77         my $last_build_row;
78         if ($git_head_ref)
79         {
80                 $last_build_row = 
81                   $db->selectrow_hashref($last_build_statement,undef,
82                                                                  $system,$branch,$logdate);
83                 $last_build_git_ref = $last_build_row->{git_head_ref}
84                   if $last_build_row;
85                 
86         }
87         my $last_success_row;
88         if (ref $last_build_row && $last_build_row->{stage} ne 'OK')
89         {
90                 $last_success_row =
91                   $db->selectrow_hashref($last_success_statement,undef,
92                                                                  $system,$branch,$logdate);
93                 $last_success_git_ref = $last_success_row->{git_head_ref}
94                   if $last_success_row;
95         }
96         $log=$row->[0];
97         $conf=$row->[1] || "not recorded" ;
98         $stage=$row->[2] || "unknown";
99         $changed_this_run = $row->[3];
100         $changed_since_success = $row->[4];
101         my $log_file_names = $row->[6];
102         $scm = $row->[7];
103         $scm ||= 'cvs'; # legacy scripts
104         $scmurl = $row->[8];
105         $log_file_names =~ s/^\{(.*)\}$/$1/;
106         @log_file_names=split(',',$log_file_names)
107             if $log_file_names;
108
109         $statement = q{
110
111           select operating_system, os_version, 
112                  compiler, compiler_version, 
113                  architecture,
114                  replace(owner_email,'\@',' [ a t ] ') as owner_email,
115                  sys_notes_ts::date AS sys_notes_date, sys_notes
116           from buildsystems 
117           where status = 'approved'
118                 and name = ?
119
120         };
121         $sth=$db->prepare($statement);
122         $sth->execute($system);
123         $info_row=$sth->fetchrow_hashref;
124
125         my $latest_personality = $db->selectrow_arrayref(q{
126             select os_version, compiler_version
127             from personality
128             where effective_date < ?
129             and name = ?
130             order by effective_date desc limit 1
131         }, undef, $logdate, $system);
132         if ($latest_personality)
133         {
134             $info_row->{os_version} = $latest_personality->[0];
135             $info_row->{compiler_version} = $latest_personality->[1];
136         }
137         $sth->finish;
138         $db->disconnect;
139 }
140
141 my ($changed_this_run_logs, $changed_since_success_logs);
142 ($changed_this_run, $changed_this_run_logs) = 
143   process_changed($changed_this_run,
144                                   $git_head_ref,$last_build_git_ref);
145 ($changed_since_success, $changed_since_success_logs) = 
146   process_changed($changed_since_success,
147                                   $last_build_git_ref,$last_success_git_ref);
148
149 $conf =~ s/\@/ [ a t ] /g;
150
151 print "Content-Type: text/html\n\n";
152
153 $template->process('log.tt',
154         {
155                 scm => $scm,
156                 scmurl => $scmurl,
157                 system => $system,
158                 branch => $branch,
159                 stage => $stage,
160                 urldt => $logdate,
161                 log_file_names => \@log_file_names,
162                 conf => $conf,
163                 log => $log,
164                 changed_this_run => $changed_this_run,
165                 changed_since_success => $changed_since_success,
166                 changed_this_run_logs => $changed_this_run_logs,
167                 changed_since_success_logs => $changed_since_success_logs,
168                 info_row => $info_row,
169             git_head_ref => $git_head_ref,
170             last_build_git_ref => $last_build_git_ref,
171             last_success_git_ref => $last_success_git_ref,
172
173         });
174
175 exit;
176
177 ##########################################################
178
179 sub process_changed
180 {
181
182         my $chgd = shift;
183         my $git_to = shift;
184         my $git_from = shift;
185
186     my @lines = split(/!/,$chgd);
187     my @changed_rows;
188         my %commits;
189         my @commit_logs;
190         my $gitcmd = "TZ=UTC GIT_DIR=$local_git_clone git log --date=local";
191     foreach (@lines)
192     {
193                 next if ($scm eq 'cvs' and ! m!^(pgsql|master|REL\d_\d_STABLE)/!);
194                 push(@changed_rows,[$1,$3]) if (m!(^\S+)(\s+)(\S+)!);
195                 $commits{$3} = 1 if $scm eq 'git';
196     }
197         if ($git_from && $git_to)
198         {
199                 my $format = 'commit %h %cd UTC%w(160,2,2)%s';
200                 my $gitlog = `$gitcmd --pretty=format:"$format" $git_from..$git_to 2>&1`;
201                 @commit_logs = split(/(?=^commit)/m,$gitlog)
202         }
203         else
204         {
205                 # normally we expect to have the git refs. this is just a fallback.
206                 my $format = 'epoch: %at%ncommit %h %cd UTC%w(160,2,2)%s';
207                 foreach my $commit ( keys %commits )
208                 {
209                         my $commitlog = 
210                           `$gitcmd -n 1 --pretty=format:"$format" $commit 2>&1`;
211                         push(@commit_logs,$commitlog);
212                 }
213                 @commit_logs = reverse (sort @commit_logs);
214                 s/epoch:.*\n// for (@commit_logs);
215         }
216                 return (\@changed_rows,\@commit_logs);
217 }
218