Drop 4.next
[buildfarm-server.git] / cgi-bin / show_failures.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 $template_dir);
17
18 use FindBin qw($RealBin);
19 require "$RealBin/../BuildFarmWeb.pl";
20
21 my $query = new CGI;
22 my @members = grep {$_ ne "" } $query->multi_param('member');
23 map { s/[^a-zA-Z0-9_ -]//g; } @members;
24 my $max_days =  $query->param('max_days') + 0 || 10;
25 my @branches = grep {$_ ne "" } $query->multi_param('branch');
26 map { s/[^a-zA-Z0-9+_ .-]//g; } @branches;
27 my @stages = grep {$_ ne "" } $query->multi_param('stage');
28 map { s/[^a-zA-Z0-9_ :-]//g; } @stages;
29
30 my $dsn="dbi:Pg:dbname=$dbname";
31 $dsn .= ";host=$dbhost" if $dbhost;
32 $dsn .= ";port=$dbport" if $dbport;
33
34
35 my $sort_clause = "";
36 my $presort_clause = "";
37 my $sortby = $query->param('sortby') || 'nosort';
38 if ($sortby eq 'name')
39 {
40         $sort_clause = 'lower(b.sysname),';
41 }
42 elsif ($sortby eq 'namenobranch')
43 {
44         $presort_clause = "lower(b.sysname), b.snapshot desc,"
45 }
46
47 my $db = DBI->connect($dsn,$dbuser,$dbpass,{pg_expand_array => 0}) 
48     or die("$dsn,$dbuser,$dbpass,$!");
49
50 my $get_all_branches = qq{
51
52   select distinct branch
53   from nrecent_failures
54   where branch <> 'HEAD'
55   order by branch desc
56
57 };
58
59 my $all_branches = $db->selectcol_arrayref($get_all_branches);
60 unshift (@$all_branches,'HEAD');
61
62 my $get_all_members = qq{
63
64   select distinct sysname
65   from nrecent_failures
66   order by sysname
67
68 };
69
70 my $all_members = $db->selectcol_arrayref($get_all_members);
71
72 my $get_all_stages = qq{
73
74   select distinct build_status.stage 
75   from build_status 
76     join nrecent_failures using (sysname,snapshot,branch)
77
78 };
79
80 my $all_stages = $db->selectcol_arrayref($get_all_stages);
81
82 my $statement =<<EOS;
83
84
85   select timezone('GMT'::text, 
86         now())::timestamp(0) without time zone - b.snapshot AS when_ago, 
87         b.*,
88         d.stage as current_stage
89   from nrecent_failures_db_data b
90         left join  dashboard_mat d
91                 on (d.sysname = b.sysname and d.branch = b.branch)
92   where (now()::timestamp(0) without time zone - b.snapshot) < (? * interval '1 day')
93   order by $presort_clause 
94         b.branch = 'HEAD' desc,
95         b.branch desc, 
96         $sort_clause 
97         b.snapshot desc
98
99 EOS
100 ;
101
102 my $statrows=[];
103 my $sth=$db->prepare($statement);
104 $sth->execute($max_days);
105 while (my $row = $sth->fetchrow_hashref)
106 {
107     next if (@members && ! grep {$_ eq $row->{sysname} } @members);
108     next if (@stages && ! grep {$_ eq $row->{stage} } @stages);
109     next if (@branches && ! grep {$_ eq $row->{branch} } @branches);
110     $row->{build_flags}  =~ s/^\{(.*)\}$/$1/;
111     $row->{build_flags}  =~ s/,/ /g;
112 ##      # enable-integer-datetimes is now the default
113 ##      if ($row->{branch} eq 'HEAD' || $row->{branch} gt 'REL8_3_STABLE')
114 ##      {
115 ##              $row->{build_flags} .= " --enable-integer-datetimes "
116 ##                      unless ($row->{build_flags} =~ /--(en|dis)able-integer-datetimes/);
117 ##      }
118 ##      # enable-thread-safety is now the default
119 ##      if ($row->{branch} eq 'HEAD' || $row->{branch} gt 'REL8_5_STABLE')
120 ##      {
121 ##              $row->{build_flags} .= " --enable-thread-safety "
122 ##                      unless ($row->{build_flags} =~ /--(en|dis)able-thread-safety/);
123 ##      }
124     $row->{build_flags}  =~ s/--((enable|with)-)?//g;
125         $row->{build_flags} =~ s/libxml/xml/;
126     $row->{build_flags}  =~ s/\S+=\S+//g;
127     push(@$statrows,$row);
128 }
129 $sth->finish;
130
131
132 $db->disconnect;
133
134
135 my $template_opts = { INCLUDE_PATH => $template_dir };
136 my $template = new Template($template_opts);
137
138 print "Content-Type: text/html\n\n";
139
140 $template->process('fstatus.tt',
141                 {statrows=>$statrows, 
142                  sortby => $sortby,
143                  max_days => $max_days,
144                  all_branches => $all_branches,
145                  all_members => $all_members,
146                  all_stages => $all_stages,
147                  qmembers=> \@members,
148                  qbranches => \@branches,
149                  qstages => \@stages} );
150
151 exit;