#!/usr/bin/perl -w -CDSL
#
# Copyright (C) 2012 Félix Hauri - www.F-Hauri.ch - delbackups@f-hauri.ch
# Licensed by tems of GNU/GPL v3
# Delete backups based on format: "base-YYYY-MO-DY-HRhMN"
# sorted to keep 1 dir per year, month, week, for last 10 weeks, day ans 15min.
#  ie:   each year 1 archive, each month, days, and last 10 weeks and upto
#        24x4->96 for last day. ->
#     keep max 96 1/4h + 7 day + 10 week + 12 months =>  125 + 1 by years... 
#
# Usage: delbackups [-q] [-n|-y] <root dir>
#            -q  quiet
#            -y  assume yes answer (delete)
#            -n  assume no (don't delete anything)
#
# RC will hold number of backups to delete if `-q` switch and no delete action.
#
# Syntaxe sample to create copy of backup dirs:
#   cp -al base $(date -r base +base-%Y-%m-%d-%Hh%M)  # Create copy dir
#   touch base                                        # Just before rsync
#
use strict;
use POSIX qw|strftime setlocale LC_TIME|;
use Getopt::Std;
my %opt;
getopt('', \%opt);

my $basedir='base';

die "Please specify rootdir as argument." unless ${ARGV[0]};

die "Can't access rootdir '${ARGV[0]}'." unless chdir ${ARGV[0]};

die "Can't find '$basedir' in '${ARGV[0]}'." unless -d $basedir;


my (@month,@dow);
#setlocale( LC_TIME, "C" );
map { $month[$_]=strftime( "%b", 1, 1, 1, 1, $_, 1, -1, -1, -1 ) } ( 0 .. 11 );
map { $dow[$_]=strftime( "%a", 1, 1, 1,$_, 1, 4, -1, -1, -1 ) } ( 0 .. 6 );

my ($Cw,$Cm,$Cday,$now)=split(' ',strftime('%W %Y%m %Y%m%d %s',localtime()));
my $Cdy=$Cday.'|'.strftime('%Y%m%d',localtime($now-86400));
my $C10w=join "|",map { sprintf "%02d", $_} (0..52), (0..52);
$C10w =~ s/\|$Cw.*$//;
$C10w = substr($C10w,length($C10w)-29);
my (%selfiles,%result);

opendir DH,'.';
for my $cdir (grep {/^$basedir-\d{4}-\d{2}-\d{2}-\d{2}[h-]\d{2}$/} readdir DH) {
    my ($foo,$y,$M,$d,$h,$m)=split(/[-h]/,$cdir);
    my ($w,$W,$s)=split(' ',strftime('%w %W %s',1,$m,$h,$d,$M-1,$y-1900));
    my $val=$y.$M.$d.$h.$m;
    $result{$val}=$cdir;
    $selfiles{'Y'.$y} = $val if
	! $selfiles{'Y'.$y} || $val > $selfiles{'Y'.$y};
    if ($Cm ne "$y$M") {
	$selfiles{'M'.$M} = $val if
	    ! $selfiles{'M'.$M} || $val > $selfiles{'M'.$M};
    };
    if ($W =~ /$C10w/) {
	$selfiles{'W'.$W} = $val if
	    ! $selfiles{'W'.$W} || $val > $selfiles{'W'.$W};
    };
    if ($Cday ne "$y$M$d") {
	$selfiles{'D'.$w} = $val if
	    ! $selfiles{'D'.$w} || $val > $selfiles{'D'.$w};
    };
    if (( $s+87300 > $now ) && ("$y$M$d" =~ /^($Cdy)$/)) {
	my $hclas=sprintf('H%02d',int($h*4+$m/15));	# 1/4h
	# my $hclas=sprintf('H%02d',int($h*2+$m/30));	# 1/2h
	# my $hclas=sprintf('H%02d',$h;			# 1h
	$selfiles{$hclas} = $val if
	    ! $selfiles{$hclas} || $val > $selfiles{$hclas};
    }
};
my ($cnt,$rcnt)=(0,0);
for my $key (keys %selfiles) {
    if ($result{$selfiles{$key}}) {
	delete $result{$selfiles{$key}};
	$rcnt++
    };
    $cnt++;
};

unless ($opt{'q'}) {
    printf "Keep %d (%d), delete %d backups $basedir\n",
	$rcnt,$cnt, scalar keys %result;
    my @seen;
    for my $tkind (qw|Hourly Daily Weekly Monthly Yearly|) {
	my $kind=substr($tkind,0,1);
	printf "%-12s %3d\n", $tkind,scalar grep { /^$kind/ } keys %selfiles;
	for my $bk (sort {$selfiles{$a}<=>$selfiles{$b}}
		    grep { /^$kind/ } keys %selfiles) {
	    my $idx=substr($bk,1);
	    if    ( $kind eq 'D' ) { $idx = $dow[$idx]     }
	    elsif ( $kind eq 'M' ) { $idx = $month[$idx-1] };
	    my $matches=join ' ',
		sort grep { $selfiles{$_} eq $selfiles{$bk} } keys %selfiles;
	    
	    my $sym='+';
	    $sym='' if grep {/$selfiles{$bk}/} @seen;
	    push @seen,$selfiles{$bk};
	    
	    printf "\e[%sm%1s %s/%s/%s %sh%s  %s %5s   [ %s ]\e[0m\n",
		do { $sym ? 0 : '34' },$sym, $1, $2, $3, $4, $5,
		$kind, $idx, $matches if
		$selfiles{$bk} =~/(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})/;
	};
    };
};

exit unless keys %result;

unless ($opt{'q'}) {
    printf "There is %d backups to delete:\n", scalar keys %result;
    my $cln=0;
    for my $key (sort keys %result) {
	print '    '.$1 if $result{$key} =~ /^$basedir-(.*)/;
	if ($cln++>=3) {
	    $cln=0;
	    print "\n";
	};
    }
    print "\n" if $cln;
};

my $ans;
if ($opt{'y'}) {
    $ans = 'yes';
} elsif ($opt{'n'}) {
    $ans = 'no';
} else {
    printf "Delete %d backups? ", scalar keys %result;
    $ans = <STDIN>;
};
if ( $ans =~ /^[yjo]/i ) {
    open CMD, "| xargs rm -fR ";
    for my $key (sort keys %result) {
	print CMD $result{$key}."\n";
    };
    close CMD;
} else {
    exit scalar keys %result if $opt{'q'}
};
printf "\n" unless $opt{'q'};