# HG changeset patch
# User Heiko Schlittermann (JUMPER) <hs@schlittermann.de>
# Date 1438099808 -7200
# Node ID 7bbd7b8e1cbed839cd34fce34fe4344065df6377
# Parent  0bab1e2baa76803c918813097ffc982b6a2635fc
Remove old backups

diff -r 0bab1e2baa76 -r 7bbd7b8e1cbe pg-backup
--- a/pg-backup	Tue Jul 28 16:23:33 2015 +0200
+++ b/pg-backup	Tue Jul 28 18:10:08 2015 +0200
@@ -5,15 +5,18 @@
 use warnings;
 use Pod::Usage;
 use Getopt::Long;
+use File::Basename;
 use File::Spec::Functions;
+
 	use Data::Dumper;
 
 my $opt_tasks;
 my $opt_dry;
 my $opt_keep = undef;
+my $opt_basedir = '.';
+my $opt_min_age = txt2days('1d');
 
-my $opt_basedir = '.';
-my $opt_dirname = '$version-$cluster-$date';
+my $dir_template = '$version-$cluster-$date';	# do not change!
 
 delete @ENV{grep /^LC_/ => keys %ENV};
 
@@ -22,9 +25,10 @@
 sub main {
 
 	GetOptions(
-		'k|keep' => \$opt_keep,
+		'k|keep=i' => \$opt_keep,
 		'd|basedir=s' => \$opt_basedir,
 		'dry' => \$opt_dry,
+		'min-age=s' => sub { $opt_min_age = txt2days($_[1]) },
 		'h|help' => sub { pod2usage(-verbose => 1, -exit => 0) },
 		'm|man' => sub { pod2usage(-verbose => 2, -exit => 0,
 			-noperldoc => system('perldoc -V >/dev/null 2>&1')) },
@@ -32,7 +36,15 @@
 
 	my @clusters = ls_clusters();
 
-	my @tasks = sort do {
+	# process the command line and get a list of tasks to do
+	my @tasks = map { 
+		state $date = date();
+		my $version = $_->{version};
+		my $cluster = $_->{cluster};
+		my $dirname = eval "\"$dir_template\"";
+		$_->{dirname} = catfile($opt_basedir, $dirname);
+		$_;
+	} sort do {
 		if (@ARGV) {
 			my $v = $ARGV[0];
 			if (@ARGV > 1) {
@@ -48,18 +60,9 @@
 		}
 	};
 
-	foreach my $task (@tasks) {
-		my $dirname = do {
-			state $date = date();
-			my $version = $task->{version};
-			my $cluster = $task->{cluster};
-			eval "\"$opt_dirname\"";
-		};
-		$task->{dirname} = catfile($opt_basedir, $dirname);
-	}
+	# now get the real jobe done
+	# run for all tasks, regardless of errors
 
-	# now get the real jobe done
-	my @results;
 	foreach my $task (@tasks) {
 
 		rmdir glob("$opt_basedir/*");
@@ -76,33 +79,57 @@
 
 		if ($opt_dry) {
 			print sprintf "%s %s\n", $task->{name}, "@cmd";
+			$task->{exit} = 0;
 			next;
 		}
 
 		system @cmd;
 		warn "$0: `@cmd` failed\n" if $?;
-		push @results, { task => $task, exit => $? };
+		$task->{exit} = $?;
 	}
 
 	# check the results
 	
-	foreach (@results) {
+	foreach my $task (@tasks) {
 		printf "%-10s %-20s %s\n",
-			$_->{exit} ? "FAIL:$_->{exit}" : "OK",
-			$_->{task}{cluster}{name},
-			$_->{task}{dirname};
+			$task->{exit} ? "FAIL:$task->{exit}" : 'OK',
+			$task->{cluster},
+			$task->{dirname};
 	}
 
-	return 1 if grep { $_->{exit} != 0 } @results;
 	return 0 if not $opt_keep;
 
 	# care about the backups to keep, if everything went fine so far
+	rmdir glob "$opt_basedir/*";	# remove empty directories
+
+	foreach my $task (grep { !$_->{exit} } @tasks) {
+		# sorted list, from oldest to youngest backup
+		my @old = grep { -M > $opt_min_age } glob catfile $opt_basedir, do { 
+			my $version = $task->{version};
+			my $cluster = $task->{cluster};
+			my $date = '*';
+			eval "\"$dir_template\"";
+		};
+
+		if ($opt_keep <= @old) {
+			splice @old, -1 * $opt_keep;
+			foreach (@old) {
+				if ($opt_dry) {
+					print "would unlink $_\n";
+					next;
+				}
+				unlink glob "$_/*.tar.gz";
+				rmdir $_;
+			}
+		}
+		
+	}
 	
 }
 
 sub date {
 	my @now = localtime;
-	sprintf "%4d-%02d-%02dT%02d-%02d-%02d",
+	sprintf '%4d-%02d-%02dT%02d-%02d-%02d',
 		$now[5]+1900,
 		$now[4]+1,
 		$now[3],
@@ -124,6 +151,17 @@
 	return @clusters;
 };
 
+sub txt2days {
+	local $_ = shift;
+	my $seconds;
+	if (/(\d+)w/) { $seconds += $1 * 604800; }
+	if (/(\d+)d/) { $seconds += $1 * 86400; }
+	if (/(\d+)h/) { $seconds += $1 * 3600; }
+	if (/(\d+)m/) { $seconds += $1 * 60; }
+	if (/(\d+)s?$/) { $seconds += $1; }
+	return $seconds/86400;
+}
+
 exit main() if not caller;
 
 
@@ -163,6 +201,12 @@
 
 Dry run, show what will be done. (default: undef)
 
+=item B<--min-age> I<time>
+
+The minimum age of old backups before the B<--keep> option tries to cleanup. 
+The timestamp of the directory with the tar archive is relevant. Nothing else!
+(default: 1d)
+
 =back
 
 =head1 AUTHOR