add another idiot to the filter
[buildfarm-server.git] / 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