trunk/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, dsh.*
  42     from dashboard_mat dsh
  43     order by branch = 'HEAD' desc,
  44         branch desc,
  45         snapshot desc
  46
  47
  48
  49 EOS
  50 ;
  51
  52     my $statrows=[];
  53     my $sth=$db->prepare($statement);
  54     $sth->execute;
  55     while (my $row = $sth->fetchrow_hashref)
  56     {
  57         next if (@members && ! grep {$_ eq $row->{sysname} } @members);
  58         $row->{build_flags}  =~ s/^\{(.*)\}$/$1/;
  59         $row->{build_flags}  =~ s/,/ /g;
  60         $row->{build_flags}  =~ s/--((enable|with)-)?//g;
  61         $row->{build_flags}  =~ s/\S+=\S+//g;
  62         push(@$statrows,$row);
  63     }
  64     $sth->finish;
  65
  66
  67     $db->disconnect;
  68
  69     return $statrows;
  70
  71 }
  72
  73 1;
  74
  75
  76
  77
  78