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 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 my $del_snap_sth = $db->prepare(q[
  51        DELETE FROM latest_snapshot
  52        WHERE sysname = ?
  53        AND branch = ?
  54       ]);
  55 while (my $row = $sth->fetchrow_hashref)
  56 {
  57   my $sysname = $row->{sysname};
  58   my $branch = $row->{branch};
  59   print "Considering $sysname:$branch\n";
  60   unless (grep {$_ eq $branch} @branches_of_interest)
  61   {
  62     print "** Delete branch $branch\n";
  63     $del_sth->execute($sysname,$branch);
  64     $del_dash_sth->execute($sysname,$branch);
  65     $del_snap_sth->execute($sysname,$branch);
  66   }
  67 }
  68 $db->disconnect();