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