scripts/purge_old_logs.pl

   1 #!/usr/bin/perl
   2
   3 # Called by the user the web server runs as to clean up old database
   4 # records and old build logs
   5
   6 use strict;
   7 use warnings;
   8 use DBI;
   9 use Data::Dumper;
  10
  11 use vars qw($dbhost $dbname $dbuser $dbpass $dbport
  12 );
  13
  14 use FindBin qw($RealBin);
  15 require "$RealBin/../BuildFarmWeb.pl";
  16
  17 die "no dbname" unless $dbname;
  18 die "no dbuser" unless $dbuser;
  19
  20 my $dsn="dbi:Pg:dbname=$dbname";
  21 $dsn .= ";host=$dbhost" if $dbhost;
  22 $dsn .= ";port=$dbport" if $dbport;
  23
  24 my $db = DBI->connect($dsn,$dbuser,$dbpass);
  25
  26 die $DBI::errstr unless $db;
  27
  28 my $del_sth = $db->prepare(q[
  29        DELETE FROM build_status
  30        WHERE snapshot < (now() - interval '3 months')
  31       ]);
  32 my $del_recent_sth = $db->prepare(q[
  33        DELETE FROM build_status_recent_500
  34        WHERE snapshot < (now() - interval '3 months')
  35       ]);
  36
  37 $del_sth->execute();
  38 $del_recent_sth->execute();
  39
  40 my $buildlogs = "$RealBin/../buildlogs";
  41
  42 my @dirs = `find $buildlogs -mindepth 1 -type d -ctime +95`;
  43 foreach my $dir (@dirs) {
  44   chomp $dir;
  45   print `rm -rf $dir`;
  46 }