Drop 4.next
[buildfarm-server.git] / cgi-bin / show_history.pl
1 #!/usr/bin/perl
2
3 =comment
4
5 Copyright (c) 2003-2010, Andrew Dunstan
6 Copyright (c) 2022, The Exim Maintainers
7
8 See accompanying License file for license details
9
10 =cut 
11
12 use strict;
13 use DBI;
14 use Template;
15 use CGI;
16
17 use vars qw($dbhost $dbname $dbuser $dbpass $dbport $template_dir);
18
19 use FindBin qw($RealBin);
20 require "$RealBin/../BuildFarmWeb.pl";
21
22 die "no dbname" unless $dbname;
23 die "no dbuser" unless $dbuser;
24
25 my $dsn="dbi:Pg:dbname=$dbname";
26 $dsn .= ";host=$dbhost" if $dbhost;
27 $dsn .= ";port=$dbport" if $dbport;
28
29 my $db = DBI->connect($dsn,$dbuser,$dbpass);
30
31 die $DBI::errstr unless $db;
32
33 my $query = new CGI;
34 my $member = $query->param('nm'); $member =~ s/[^a-zA-Z0-9_ -]//g;
35 my $branch = $query->param('br'); $branch =~ s/[^a-zA-Z0-9+_ .-]//g;
36 my $hm = $query->param('hm');  $hm =~ s/[^a-zA-Z0-9_ -]//g;
37 $hm = '240' unless $hm =~ /^\d+$/;
38
39 my $latest_personality = $db->selectrow_arrayref(q{
40             select os_version, compiler_version
41             from personality
42             where name = ?
43             order by effective_date desc limit 1
44         }, undef, $member);
45
46 my $systemdata = q{
47     select operating_system, os_version, compiler, compiler_version, architecture,
48       owner_email, sys_notes_ts::date AS sys_notes_date, sys_notes
49     from buildsystems b
50     where b.status = 'approved'
51         and name = ?
52 };
53
54 my $statement = qq{
55    WITH x AS 
56    (  select * 
57       from build_status_recent_500
58       where sysname = ? 
59          and branch = ?
60    )
61    SELECT (now() at time zone 'GMT')::timestamp(0) - x.snapshot as when_ago, 
62             x.sysname, x.snapshot, x.status, x.stage, s.log_text, x.git_head_ref
63    FROM x 
64    LEFT JOIN build_status_log s
65    ON x.snapshot = s.snapshot AND s.log_stage = 'test-results.log'
66    ORDER BY x.snapshot desc  
67    LIMIT $hm
68 }
69 ;
70
71 my $sth = $db->prepare($systemdata);
72 $sth->execute($member);
73 my $sysrow = $sth->fetchrow_hashref;
74 my $statrows=[];
75 $sth=$db->prepare($statement);
76 $sth->execute($member,$branch);
77 while (my $row = $sth->fetchrow_hashref)
78 {
79     last unless $sysrow;
80     while (my($k,$v) = each %$sysrow) { $row->{$k} = $v; }
81     $row->{owner_email} =~ s/\@/ [ a t ] /;
82     if ($latest_personality)
83     {
84         $row->{os_version} = $latest_personality->[0];
85         $row->{compiler_version} = $latest_personality->[1];
86     }
87
88     # convert list of individual testresults to list of ranges of equal results
89     # for speed of display
90     if (defined($row->{log_text}))
91       {         # convert to a hash, find ranges, output list of ranges
92       my $h = { split /\s+/, $row->{log_text} };
93       my $i;
94       my $start;
95       my @ranges;
96
97       foreach my $k (sort {$a<=>$b} keys %$h)
98         {
99         if (defined $start)
100           {
101           if ($h->{$k} ne $h->{$start})
102             {
103             push @ranges, sprintf("%s %s %s", $h->{$start},  $start,  $i);
104             $start = $k;
105             $i = 1;
106             }
107           else
108             {
109             $i++;
110             }
111           }
112         else
113           {
114           $start = $k;
115           $i = 1;
116           }
117         }
118       if (defined $start)
119         {
120         push @ranges, sprintf("%s %s %s", $h->{$start},  $start,  $i);
121         }
122
123       $row->{log_text} = \@ranges;
124       }
125
126     push(@$statrows,$row);
127 }
128
129 $sth->finish;
130
131 $db->disconnect;
132
133 my $template_opts = { INCLUDE_PATH => $template_dir, EVAL_PERL => 1 };
134 my $template = new Template($template_opts);
135
136 print "Content-Type: text/html\n\n";
137
138 $template->process('history.tt',
139                    {statrows=>$statrows, 
140                     branch=>$branch, 
141                     member => $member,
142                     hm => $hm
143                     });
144
145 exit;