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->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->param('branch');
  26 map { s/[^a-zA-Z0-9_ .-]//g; } @branches;
  27 my @stages = grep {$_ ne "" } $query->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;