cgi-bin/show_status_soap.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
  13 use vars qw($dbhost $dbname $dbuser $dbpass $dbport);
  14
  15 require "$ENV{BFConfDir}/BuildFarmWeb.pl";
  16
  17 use SOAP::Transport::HTTP;
  18
  19 SOAP::Transport::HTTP::CGI->dispatch_to('PGBuildFarm')->handle;
  20
  21 exit;
  22
  23 package PGBuildFarm;
  24
  25 use DBI;
  26
  27 sub get_status
  28
  29 {
  30     my $class = shift;
  31     my @members = @_;
  32
  33     my $dsn="dbi:Pg:dbname=$::dbname";
  34     $dsn .= ";host=$::dbhost" if $::dbhost;
  35     $dsn .= ";port=$::dbport" if $::dbport;
  36
  37     my $db = DBI->connect($dsn,$::dbuser,$::dbpass) or
  38         die("$dsn,$::dbuser,$::dbpass,$!");
  39
  40     # there is possibly some redundancy in this query, but it makes
  41     # a lot of the processing simpler.
  42
  43     my $statement =<<EOS;
  44
  45
  46     select (now() at time zone 'GMT')::timestamp(0) - snapshot as when_ago, dsh.*
  47     from dashboard_mat dsh
  48     order by branch = 'HEAD' desc,
  49         branch desc,
  50         snapshot desc
  51
  52
  53
  54 EOS
  55 ;
  56
  57     my $statrows=[];
  58     my $sth=$db->prepare($statement);
  59     $sth->execute;
  60     while (my $row = $sth->fetchrow_hashref)
  61     {
  62         next if (@members && ! grep {$_ eq $row->{sysname} } @members);
  63         $row->{build_flags}  =~ s/^\{(.*)\}$/$1/;
  64         $row->{build_flags}  =~ s/,/ /g;
  65         $row->{build_flags}  =~ s/--((enable|with)-)?//g;
  66         $row->{build_flags}  =~ s/\S+=\S+//g;
  67         push(@$statrows,$row);
  68     }
  69     $sth->finish;
  70
  71
  72     $db->disconnect;
  73
  74     return $statrows;
  75
  76 }
  77
  78 1;
  79
  80
  81
  82
  83