Shredder for backup script (Masterhost)

gistfile1.pl

#!/usr/bin/perl -w
use strict;
use Data::Dumper;

our $m;

run($_) for @{[
        [ '/mnt/fs_admin/BACKUP/masterhost/u11111/backup_u11111', 'domain\.ru' ],
        [ '/mnt/fs_admin/BACKUP/masterhost/u11111/backup_u11111/mysql', 'u11111\_domain\_'],
]};

sub run {
        our ($dir, $mask) = @{ $_[0] } or return;
        opendir(my $dh, $dir) || die "can't opendir $dir: $!";
        for (readdir($dh)) {
                my $f = "$dir/$_";
                next unless /^$mask/;
                &clean($f);
        }
        closedir $dh;
}

sub clean($)
{
        my $f = shift or return;
        my $mtime = (stat($f))[9] or die;
        my ($mday, $mon, $wday) = (localtime($mtime))[3,4,6];
        my $today = time;
        my $age = ($today-$mtime)/60/60/24; # days
        my $action;

        if ($age > 7 && $age < 90) {
                unlink $f unless $wday == 6;
        } elsif ($age > 90 && $age < 365) {
                push @{ $m->{$mon}->{day}->{$mday}}, $f;
        } elsif ($age > 365) {
                unlink $f;
        }
}

for my $mon (keys %{$m}) {
        my $max = 0;
        for my $day (keys %{$m->{$mon}->{day}}) {
                $max = $day if $day > $max;
        }
        for my $day (keys %{$m->{$mon}->{day}}) {
                next if $day == $max;
                unlink @{$m->{$mon}->{day}->{$day}};
        }
}