fix address generation weirdness
[buildfarm-server.git] / 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