fix address generation weirdness
[buildfarm-server.git] / trunk / cgi-bin / show_status.pl
1 #!/usr/bin/perl
2
3 use strict;
4 use DBI;
5 use Template;
6 use CGI;
7
8 use vars qw($dbhost $dbname $dbuser $dbpass $dbport $template_dir);
9
10
11 require "$ENV{BFConfDir}/BuildFarmWeb.pl";
12
13 my $query = new CGI;
14 my @members = $query->param('member');
15 map { s/[^a-zA-Z0-9_ -]//g; } @members;
16
17 my $dsn="dbi:Pg:dbname=$dbname";
18 $dsn .= ";host=$dbhost" if $dbhost;
19 $dsn .= ";port=$dbport" if $dbport;
20
21
22 my $sort_clause = "";
23 my $sortby = $query->param('sortby') || 'nosort';
24 if ($sortby eq 'name')
25 {
26         $sort_clause = 'lower(sysname),';
27 }
28 elsif ($sortby eq 'os')
29 {
30         $sort_clause = 'lower(operating_system), os_version desc,'; 
31 }
32 elsif ($sortby eq 'compiler')
33 {
34         $sort_clause = "lower(compiler), compiler_version,";
35 }
36
37 my $db = DBI->connect($dsn,$dbuser,$dbpass,{pg_expand_array => 0}) 
38     or die("$dsn,$dbuser,$dbpass,$!");
39
40 my $statement =<<EOS;
41
42
43   select timezone('GMT'::text, now())::timestamp(0) without time zone - b.snapshot AS when_ago, b.*
44   from dashboard_mat b
45   order by branch = 'HEAD' desc,
46         branch desc, $sort_clause 
47         snapshot desc
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         # enable-integer-datetimes is now the default
61         if ($row->{branch} eq 'HEAD' || $row->{branch} gt 'REL8_3_STABLE')
62         {
63                 $row->{build_flags} .= " --enable-integer-datetimes "
64                         unless ($row->{build_flags} =~ /--(en|dis)able-integer-datetimes/);
65         }
66         # enable-thread-safety is now the default
67         if ($row->{branch} eq 'HEAD' || $row->{branch} gt 'REL8_5_STABLE')
68         {
69                 $row->{build_flags} .= " --enable-thread-safety "
70                         unless ($row->{build_flags} =~ /--(en|dis)able-thread-safety/);
71         }
72     $row->{build_flags}  =~ s/--((enable|with)-)?//g;
73         $row->{build_flags} =~ s/libxml/xml/;
74     $row->{build_flags}  =~ s/\S+=\S+//g;
75     push(@$statrows,$row);
76 }
77 $sth->finish;
78
79
80 $db->disconnect;
81
82
83 my $template_opts = { INCLUDE_PATH => $template_dir };
84 my $template = new Template($template_opts);
85
86 print "Content-Type: text/html\n\n";
87
88 $template->process('status.tt',
89                 {statrows=>$statrows});
90
91 exit;
92