#!/usr/bin/env perl

use v5.10;
use warnings;
use strict;
use File::Basename;
use File::Spec;
use Data::Dumper;
use POSIX qw(strftime);

my $BACKROOT = $ARGV[0];

sub getBackupsFreeSpace {
	my $free = `df -h -BG --output=avail $BACKROOT | tail -n1`;
	chomp $free;
	return ($free =~ s/G$//r) + 0;
}

my $freePre = getBackupsFreeSpace();

my @stamps = split /\n/, `find $BACKROOT -name 'stamps'`;

sub older_than {
	my ( $stamp, @stamps ) = @_;
	return grep { $_ lt $stamp } @stamps;
}

sub drop_backups {
	my ( $backup_root, $path, @backups ) = @_;
	for my $backup ( @backups ) {
		my $snar_path = File::Spec->join( $backup_root, "stamps", $path, "$backup.snar.xz" );
		my $backup_path = File::Spec->join( $backup_root, $path, "$backup.tar.xz" );
		say "    unlink $snar_path…";
		unlink $snar_path;
		say "    unlink $backup_path…";
		unlink $backup_path;
	}
}


sub timestamp_months_ago {
	my ( $how_many ) = @_;
	my $months_ago_stamp = time() - ($how_many * 31 * 24 * 3600);
	return strftime "%Y-%m-%d", localtime($months_ago_stamp);
}

my $last_daily_stamp = timestamp_months_ago(1);
my $last_weekly_stamp = timestamp_months_ago(2);
my $last_full_stamp = timestamp_months_ago(4);

my @summary = ();
for my $stamp ( @stamps ) {
	my $backup_root = dirname($stamp);
	my @snars = split /\n/, `find $stamp -name '*.snar.xz' | sort`;
	my %backups = ();
	for my $snar ( @snars ) {
		my $rel = File::Spec->abs2rel($snar, $stamp);
		my $backup_path = dirname($rel);
		my $backup_stamp = basename($rel) =~ s/[.]snar[.]xz//r;
		if ( not exists $backups{ $backup_path } ) {
			$backups{ $backup_path } = { "daily" => [], "weekly" => [], "full" => [] };
		}
		my ( $timestamp, $type ) = split /[.]/, $backup_stamp;
		push( @{$backups{ $backup_path }->{ $type }}, $timestamp );
	}
	while (my ($path, $backups) = each %backups ) {
		my $info_printed = 0;
		my $info = sub {
			my ( $trigger, @msgs ) = @_;
			if ( $trigger) {
				say "\n$backup_root -> $path…" unless $info_printed;
				$info_printed = 1;
				say join "\n", @msgs;
			}
		};
		my @full = @{$backups->{full}};
		my @weekly = @{$backups->{weekly}};
		my @daily = @{$backups->{daily}};

		push(@summary, sprintf("%-8s -> %-24s %2d full, %2d weekly, %2d daily backups",
		                       (basename($backup_root) =~ s/backup-//r), $path,
		                       scalar @full, scalar @weekly, scalar @daily));

		# drop daily backups older than the last weekly backup at least month old
		# except for trailing daily backups
		my @old_weekly = older_than( $last_daily_stamp, @weekly );
		next if (@old_weekly == 0);
		my $last_weekly_with_dailys = $old_weekly[-1];
		my @daily_to_delete = older_than( $last_weekly_with_dailys, @daily );
		$info->( scalar @daily_to_delete );
		drop_backups( $backup_root, $path, map { "$_.daily" } @daily_to_delete );

		# drop weekly backups older than the last full backup at least two months old
		my @old_full = older_than( $last_weekly_stamp, @full );
		next if (@old_full == 0);
		my $last_full_with_weeklys = $old_full[-1];
		my @weekly_to_delete = older_than( $last_full_with_weeklys, @weekly );
		$info->( scalar @weekly_to_delete ); #, "    weekly_to_delete = " . join " ", @weekly_to_delete );
		drop_backups( $backup_root, $path, map { "$_.weekly" } @weekly_to_delete );

		my @full_to_delete = older_than( $last_full_stamp, @full );
		while ( @full_to_delete && (scalar @full_to_delete) > (scalar @full - 2) ) {
			pop @full_to_delete;
		}
		$info->( scalar @full_to_delete, "    full_to_delete = " . join " ", @full_to_delete );
		drop_backups( $backup_root, $path, map { "$_.full" } @full_to_delete );
	}
}

my $freeDiff = getBackupsFreeSpace() - $freePre;

print "\n\n";
print(join "\n", sort(@summary));
print "\n\nfreed ${freeDiff}G\n\n";
system("df -h $BACKROOT")
