#!/usr/bin/perl -w
# $Id: backuppc_cleanup.pl 745 2005-10-31 22:40:41Z ski $
# $URL: http://svn/svn/sys/apps/backuppc/serverbin/backuppc_cleanup.pl $
#
# Script to delete older backuppc backups when the file system gets too full
# It is recommended that backuppc is stopped when running this script as it
# does not check for lock files.  Also, run 
#
# $backuppc_bin_dir/BackupPC_nightly -m 0 255
#
# to clean up the pool after running this script.
#
# $fulls_to_keep are the number of fulls to keep
# 
# Author: Ski Kacoroski (kacoroski@comcast.net)
# Copyright: GNU GPL version 2 or later
#
my $fulls_to_keep = 2;
my $backuppc_dir = "/data/backuppc";


# Nothing to change below this line
my ($fh, $client, %backup_list, $backup_num, $backup_type, $fulls);

for $client (`ls "$backuppc_dir/pc"`) {
  chomp $client;

  # Get the list of backups from disk
  open($fh, "<$backuppc_dir/pc/$client/backups")
    or die "Could not open the backups files for $client: $!\n";
  undef %backup_list;
  while (<$fh>) {
    chomp;
    ($backup_num, $backup_type) = split("\t",$_,3);
    $backup_list{$backup_num} = $_;
  }
  close($fh);

  # Delete the older backups from disk
  $fulls = 0;
  for $backup_num (reverse sort by_number keys %backup_list) {
    $fulls++ if $backup_list{$backup_num} =~ /full/;
    next if $fulls < $fulls_to_keep;
    next if $fulls == $fulls_to_keep and $backup_list{$backup_num} =~ /full/;
    print "Removing $backuppc_dir/pc/$client/$backup_num $backuppc_dir/pc/$client/XferLOG.$backup_num.z\n";
    $backup_list{$backup_num} = "D";
    `rm -rf $backuppc_dir/pc/$client/$backup_num $backuppc_dir/pc/$client/XferLOG.$backup_num.z`;
  }

  # update the backups file
  rename "$backuppc_dir/pc/$client/backups", "$backuppc_dir/pc/$client/backups.old";
  open($fh, ">$backuppc_dir/pc/$client/backups")
    or die "Could not open the backups file for $client for writing: $!\n";
  for $backup_num (sort by_number keys %backup_list) {
    next if $backup_list{$backup_num} eq "D";
    print $fh "$backup_list{$backup_num}\n";
  }
  close($fh);
}

sub by_number { $a <=> $b }