Permalink
Fetching contributors…
Cannot retrieve contributors at this time
executable file 66 lines (57 sloc) 1.97 KB
#!/usr/bin/perl -w
#
# expirebackups - find old backups to be deleted
#
# Copyright (C) 2004,2006,2007,2008,2011 Christian Garbs <mitch@cgarbs.de>
# licensed under GNU GPL v2 or later
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
#
use strict;
# parameter handling
die "usage:\n\t$0 [keep_this_many] <backup_path>\n" unless (@ARGV == 1 or @ARGV == 2);
my $keep_count = 4;
if (@ARGV == 2) {
$keep_count = shift @ARGV;
die "[keep_this_many] may only contain digits!\n" if ($keep_count =~ y/0-9//c);
}
my ($backup_path) = @ARGV;
$backup_path =~ s:/+$::;
# read file list
my (%backup, @keep, @delete);
opendir DIR, $backup_path or die "can't opendir() `$backup_path': $!\n";
foreach ( grep { -f "$backup_path/$_" } readdir(DIR) ) {
if ( /^((.+)-(\d{4})(\d{2})(\d{2})\.tar\.bz2)$/ ) {
push @{$backup{$2}}, {
'FILE' => $1,
'NAME' => $2,
'YEAR' => $3,
'MONTH' => $4,
'DAY' => $5,
'AGE' => (($3*13)+$4)*32+$5
}
}
}
closedir DIR or die "can't closedir() `$backup_path': $!\n";
foreach my $file (keys %backup) {
my @backup = @{$backup{$file}};
# sort newest first
@backup = sort {$b->{AGE} <=> $a->{AGE}} @backup;
# keep latest 4 entries
@keep = splice @backup, 0, $keep_count;
# sort oldest first
@backup = reverse @backup;
# print file list
print "$backup_path/$_->{FILE}\n" foreach (@backup);
}