add hs/string_is_ip_address
[buildfarm-server.git] / scripts / 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
11 use FindBin qw($RealBin);
12 require "$RealBin/../BuildFarmWeb.pl";
13
14 die "no dbname" unless $dbname;
15 die "no dbuser" unless $dbuser;
16
17 my $dsn="dbi:Pg:dbname=$dbname";
18 $dsn .= ";host=$dbhost" if $dbhost;
19 $dsn .= ";port=$dbport" if $dbport;
20
21 my $db = DBI->connect($dsn,$dbuser,$dbpass);
22
23 die $DBI::errstr unless $db;
24
25 my ($brhandle,@branches_of_interest);
26 if (open($brhandle,"$RealBin/../htdocs/branches_of_interest.txt"))
27 {
28     @branches_of_interest = <$brhandle>;
29     close($brhandle);
30     chomp(@branches_of_interest);
31 }
32
33 my $sth = $db->prepare(q[ 
34        SELECT DISTINCT ON (sysname,branch)
35        sysname,branch
36        FROM build_status AS s
37        JOIN buildsystems AS b ON (s.sysname = b.name)
38        ORDER BY sysname, branch ASC
39       ]);
40 $sth->execute();
41
42 my $del_sth = $db->prepare(q[
43        DELETE FROM build_status
44        WHERE sysname = ?
45        AND branch = ?
46       ]);
47 my $del_dash_sth = $db->prepare(q[
48        DELETE FROM dashboard_mat
49        WHERE sysname = ?
50        AND branch = ?
51       ]);
52 my $del_snap_sth = $db->prepare(q[
53        DELETE FROM latest_snapshot
54        WHERE sysname = ?
55        AND branch = ?
56       ]);
57 while (my $row = $sth->fetchrow_hashref)
58 {
59   my $sysname = $row->{sysname};
60   my $branch = $row->{branch};
61   print "Considering $sysname:$branch\n";
62   unless (grep {$_ eq $branch} @branches_of_interest)
63   {
64     print "** Delete branch $branch\n";
65     $del_sth->execute($sysname,$branch);
66     $del_dash_sth->execute($sysname,$branch);
67     $del_snap_sth->execute($sysname,$branch);
68   }
69 }
70 $db->disconnect();