cgi-bin/show_status_soap.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4
   5
   6 use vars qw($dbhost $dbname $dbuser $dbpass $dbport);
   7
   8 require "$ENV{BFConfDir}/BuildFarmWeb.pl";
   9
  10 use lib "/home/community/pgbuildfarm/lib/lib/perl5/site_perl";
  11
  12 use SOAP::Transport::HTTP;
  13
  14 SOAP::Transport::HTTP::CGI->dispatch_to('PGBuildFarm')->handle;
  15
  16 exit;
  17
  18 package PGBuildFarm;
  19
  20 use DBI;
  21
  22 sub get_status
  23
  24 {
  25     my $class = shift;
  26     my @members = @_;
  27
  28     my $dsn="dbi:Pg:dbname=$::dbname";
  29     $dsn .= ";host=$::dbhost" if $::dbhost;
  30     $dsn .= ";port=$::dbport" if $::dbport;
  31
  32     my $db = DBI->connect($dsn,$::dbuser,$::dbpass) or
  33         die("$dsn,$::dbuser,$::dbpass,$!");
  34
  35     # there is possibly some redundancy in this query, but it makes
  36     # a lot of the processing simpler.
  37
  38     my $statement =<<EOS;
  39
  40
  41     select (now() at time zone 'GMT')::timestamp(0) - snapshot as when_ago,
  42         sysname, snapshot, b.status, stage, branch, build_flags,
  43         operating_system, coalesce(b.os_version,s.os_version) as os_version,
  44         compiler,
  45         coalesce(b.compiler_version, s.compiler_version) as compiler_version,
  46         architecture
  47     from buildsystems s,
  48         (
  49         select distinct on (bs.sysname, bs.branch, bs.report_time)
  50                sysname, snapshot, status, stage, branch, build_flags,
  51                report_time ,compiler_version, os_version
  52         from build_status bs
  53              left join
  54              personality p
  55              on (p.name = bs.sysname and p.effective_date <= bs.report_time)
  56         order by bs.sysname, bs.branch, bs.report_time,
  57                  p.effective_date is null, p.effective_date desc
  58         ) as b
  59         natural join
  60         (select sysname, branch, max(snapshot) as snapshot
  61         from build_status
  62         group by sysname, branch
  63         having max(snapshot) > now() - '30 days'::interval
  64         ) m
  65     where name = sysname
  66         and s.status = 'approved'
  67     order by branch = 'HEAD' desc,
  68         branch desc,
  69         snapshot desc
  70
  71
  72
  73 EOS
  74 ;
  75
  76     my $statrows=[];
  77     my $sth=$db->prepare($statement);
  78     $sth->execute;
  79     while (my $row = $sth->fetchrow_hashref)
  80     {
  81         next if (@members && ! grep {$_ eq $row->{sysname} } @members);
  82         $row->{build_flags}  =~ s/^\{(.*)\}$/$1/;
  83         $row->{build_flags}  =~ s/,/ /g;
  84         $row->{build_flags}  =~ s/--((enable|with)-)?//g;
  85         $row->{build_flags}  =~ s/\S+=\S+//g;
  86         push(@$statrows,$row);
  87     }
  88     $sth->finish;
  89
  90
  91     $db->disconnect;
  92
  93     return $statrows;
  94
  95 }
  96
  97 1;
  98
  99
 100
 101
 102