X-Git-Url: https://git.exim.org/buildfarm-server.git/blobdiff_plain/2e86f437603ee6977c9ca751e97e490ce2768584..b82a14979c08ae940b8c0b8df8583ae4e79ceea8:/cgi-bin/show_history.pl diff --git a/cgi-bin/show_history.pl b/cgi-bin/show_history.pl index 98a8860..50b1bf3 100755 --- a/cgi-bin/show_history.pl +++ b/cgi-bin/show_history.pl @@ -1,15 +1,22 @@ #!/usr/bin/perl +=comment + +Copyright (c) 2003-2010, Andrew Dunstan + +See accompanying License file for license details + +=cut + use strict; use DBI; use Template; use CGI; -use vars qw($dbhost $dbname $dbuser $dbpass $dbport); +use vars qw($dbhost $dbname $dbuser $dbpass $dbport $template_dir); - -require "$ENV{BFConfDir}/BuildFarmWeb.pl"; -#require "BuildFarmWeb.pl"; +use FindBin qw($RealBin); +require "$RealBin/../BuildFarmWeb.pl"; die "no dbname" unless $dbname; die "no dbuser" unless $dbuser; @@ -24,49 +31,110 @@ die $DBI::errstr unless $db; my $query = new CGI; my $member = $query->param('nm'); $member =~ s/[^a-zA-Z0-9_ -]//g; -my $branch = $query->param('br'); $branch =~ s/[^a-zA-Z0-9_ -]//g; +my $branch = $query->param('br'); $branch =~ s/[^a-zA-Z0-9+_ .-]//g; my $hm = $query->param('hm'); $hm =~ s/[^a-zA-Z0-9_ -]//g; $hm = '240' unless $hm =~ /^\d+$/; -# we don't really need to do this join, since we only want -# one row from buildsystems. but it means we only have to run one -# query. If it gets heavy we'll split it up and run two - -my $statement = <selectrow_arrayref(q{ + select os_version, compiler_version + from personality + where name = ? + order by effective_date desc limit 1 + }, undef, $member); + +my $systemdata = q{ + select operating_system, os_version, compiler, compiler_version, architecture, + owner_email, sys_notes_ts::date AS sys_notes_date, sys_notes + from buildsystems b + where b.status = 'approved' + and name = ? +}; + +my $statement = qq{ + WITH x AS + ( select * + from build_status_recent_500 + where sysname = ? + and branch = ? + ) + SELECT (now() at time zone 'GMT')::timestamp(0) - x.snapshot as when_ago, + x.sysname, x.snapshot, x.status, x.stage, s.log_text + FROM x + LEFT JOIN build_status_log s + ON x.snapshot = s.snapshot AND s.log_stage = 'test-results.log' + ORDER BY x.snapshot desc + LIMIT $hm +} ; +my $sth = $db->prepare($systemdata); +$sth->execute($member); +my $sysrow = $sth->fetchrow_hashref; my $statrows=[]; -my $sth=$db->prepare($statement); +$sth=$db->prepare($statement); $sth->execute($member,$branch); while (my $row = $sth->fetchrow_hashref) { + last unless $sysrow; + while (my($k,$v) = each %$sysrow) { $row->{$k} = $v; } $row->{owner_email} =~ s/\@/ [ a t ] /; - push(@$statrows,$row); + if ($latest_personality) + { + $row->{os_version} = $latest_personality->[0]; + $row->{compiler_version} = $latest_personality->[1]; + } + + # convert list of individual testresults to list of ranges of equal results + # for speed of display + if (defined($row->{log_text})) + { # convert to a hash, find ranges, output list of ranges + my $h = { split /\s+/, $row->{log_text} }; + my $i; + my $start; + my @ranges; + + foreach my $k (sort {$a<=>$b} keys %$h) + { + if (defined $start) + { + if ($h->{$k} ne $h->{$start}) + { + push @ranges, sprintf("%s %s %s", $h->{$start}, $start, $i); + $start = $k; + $i = 1; + } + else + { + $i++; + } + } + else + { + $start = $k; + $i = 1; + } + } + if (defined $start) + { + push @ranges, sprintf("%s %s %s", $h->{$start}, $start, $i); + } + + $row->{log_text} = \@ranges; + } + + push(@$statrows,$row); } + $sth->finish; $db->disconnect; -my $template = new Template({EVAL_PERL => 1}); +my $template_opts = { INCLUDE_PATH => $template_dir, EVAL_PERL => 1 }; +my $template = new Template($template_opts); print "Content-Type: text/html\n\n"; -$template->process(\*DATA, +$template->process('history.tt', {statrows=>$statrows, branch=>$branch, member => $member, @@ -74,83 +142,3 @@ $template->process(\*DATA, }); exit; - -__DATA__ -[%- BLOCK cl %] class="[% SWITCH bgfor -%] - [%- CASE 'OK' %]pass[% CASE 'ContribCheck' %]warn[% CASE [ 'Check' 'InstallCheck' ] %]warnx[% CASE %]fail[% END %]" -[%- END -%] - - - - - PostgreSQL BuildFarm History - - - - - -
- -
-

PostgreSQL BuildFarm Status History

- - - - - - - - - -
System Detail
Farm member[% member %]
OS[% statrows.0.operating_system %] [% statrows.0.os_version %]
Compiler[% statrows.0.compiler %] [% statrows.0.compiler_version %]
Architecture[% statrows.0.architecture %]
Owner[% statrows.0.owner_email %]
-

Branch: [% branch %][% IF statrows.size >= hm %] (last [% hm %] entries shown)[% END %]

-[% BLOCK stdet %] - - [%- row.when_ago | replace('\s',' ') %] ago  - [% row.stage -%] - - [%- IF row.stage != 'OK' %]Details[% ELSE %]Config[% END -%] - - -[% END %] - -[% FOREACH offset IN [0,1,2] %][% low = offset * statrows.size / 3 ; high = -1 + (offset + 1) * statrows.size / 3 %] -[% TRY %][% PERL %] - use POSIX qw(floor); - $stash->set(low => floor($stash->get('low'))); - $stash->set(high => floor($stash->get('high'))); -[% END %][% CATCH %] [% END %] - -[% END %] -
- - [% FOREACH xrow IN statrows.slice(low,high) %][% PROCESS stdet row=xrow %][% END %] -
-
-
-

-Hosting for the PostgreSQL Buildfarm is generously -provided by: -CommandPrompt, -The PostgreSQL Company -

-
- -