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();