Minor adjustments
[buildfarm-server.git] / delete_unlisted_branches.pl
1 #!/usr/bin/perl
2
3 use strict;
4 use warnings;
5 use DBI;
6 use Data::Dumper;
7
8 use vars qw($dbhost $dbname $dbuser $dbpass $dbport
9 );
10 require "$ENV{BFConfDir}/BuildFarmWeb.pl";
11
12 die "no dbname" unless $dbname;
13 die "no dbuser" unless $dbuser;
14
15 my $dsn="dbi:Pg:dbname=$dbname";
16 $dsn .= ";host=$dbhost" if $dbhost;
17 $dsn .= ";port=$dbport" if $dbport;
18
19 my $db = DBI->connect($dsn,$dbuser,$dbpass);
20
21 die $DBI::errstr unless $db;
22
23 my ($brhandle,@branches_of_interest);
24 if (open($brhandle,"$ENV{BFConfDir}/htdocs/branches_of_interest.txt"))
25 {
26     @branches_of_interest = <$brhandle>;
27     close($brhandle);
28     chomp(@branches_of_interest);
29 }
30
31 my $sth = $db->prepare(q[ 
32        SELECT DISTINCT ON (sysname,branch)
33        sysname,branch
34        FROM build_status AS s
35        JOIN buildsystems AS b ON (s.sysname = b.name)
36        ORDER BY sysname, branch ASC
37       ]);
38 $sth->execute();
39
40 my $del_sth = $db->prepare(q[
41        DELETE FROM build_status
42        WHERE sysname = ?
43        AND branch = ?
44       ]);
45 my $del_dash_sth = $db->prepare(q[
46        DELETE FROM dashboard_mat
47        WHERE sysname = ?
48        AND branch = ?
49       ]);
50
51 while (my $row = $sth->fetchrow_hashref)
52 {
53   my $sysname = $row->{sysname};
54   my $branch = $row->{branch};
55   print "Considering $sysname:$branch\n";
56   unless (grep {$_ eq $branch} @branches_of_interest)
57   {
58     print "** Delete branch $branch\n";
59     $del_sth->execute($sysname,$branch);
60     $del_dash_sth->execute($sysname,$branch);
61   }
62 }
63 $db->disconnect();