Delete old backups

delete-old-hourly-backups

#!/usr/bin/perl

use strict;
use warnings;
use File::Path qw( remove_tree );

# Call it by ./delete-old-hourly-backups DIRNAME
# Keeps exactly 1 backup directory per day
# Assumes the following directory structure below DIRNAME/:
# back-2018-01-15T13_15_00
# back-2018-01-15T14_45_00
# ...
# In fact, it's irrelevant how often the backup was run each day. 
# Following the above example, at the end only the newest directory from back-2018-01-15T* is there.
# All other directories from this day will be removed.
# But it doesn't touch the newest 5 days.


my $now = time;
print "Now: $now.\n";

my %backups;

foreach my $dir ( @ARGV ) {

    print "# Dir: $dir\n";

    opendir( my $dh, $dir );

    while ( readdir $dh ) {

        next unless /^back-(2...-..-..)T(.._.._..)$/;

        my $date = $1;
        my $time = $2;

        #print "# Subdir: $_\n";

        my $age_in_s = $now - (stat "$dir/$_")[10];  # 10 = ctime
        #printf "%s: %07d - %07d seconds old\n", $_, $now, $age_in_s;
        next if $age_in_s < 3600 * 24 * 5;  # Skip newest 5 days

        $backups{ $date }{ 'count' }++;
        $backups{ $date }{ 'age_in_s' } = $age_in_s;
        $backups{ $date }{ 'parent_dir' } = $dir;
        push @{ $backups{ $date }{ 'dirs' } }, $_;

    }

    foreach my $date ( sort keys %backups ) {

        my $count = $backups{$date}{'count'};

        next if $count <= 1;

        print "Date: $date";
        print ", count: $count";
        print "\n";

        my @dirs = sort @{ $backups{ $date }{ 'dirs' } };

        my $array_count = scalar @dirs;
        next if $array_count != $count;  # Double check
        print @dirs;
        print "\n";

        my $parent_dir = $backups{ $date }{ 'parent_dir' };

        while ( scalar @dirs > 1 ) {
            my $dir2delete = shift @dirs;
            print "<<$dir2delete>>\n";
            ## REMOVE THE COMMENT TO REMOVE THE DIR :-) ##   remove_tree( "$parent_dir/$dir2delete" );
        }

    }

}