File::Maintenance - Maintain files based on their age.

    use File::Maintenance;

    my $fm = File::Maintenance->new({
            directory => '/tmp',
            pattern   => '*.sess',
            age       => '5d', #older than five days
    });

    $fm->test(1); # don't execute the purge
    $fm->purge; # prints the action to STDOUT but doesn't purge files

    $fm->test(0); # It's all for real
    $fm->purge; # Will delete old *.sess files from /tmp
    $fm->recurse(1);
    $fm->purge; # Will delete old *.sess files from /tmp and sub-directories

    use File::Maintenance;

    my $fm = File::Maintenance->new({
            directory         => '/my/data/files',
            archive_directory => '/my/archive/files'
            pattern           => '*',
            recurse           => 1, # subdirectories too
            age               => '30m' # older than 30 minutes
    });

    $fm->archive;

    use File::Maintenance;

    my $fm = File::Maintenance->new();
    $fm->directory('/my/data/files');
    $fm->archive_directory('/my/archive/files);
    $fm->pattern('*');
    $fm->recurse(1);
    $fm->age('30m);
    $fm->archive;

    $fm->zip;

    $fm->gzip;

    $fm->bzip2;

        $fm->directory('/tmp');

        $fm->pattern('backup*.tar.gz');

        $fm->pattern(qr/^(foo|bar)\d\d\.jpg$/);

        $fm->age('1d'); # Files older than 1 day
        $fm->age('4h'); # Files older than 4 hours

    perldoc File::Maintenance

package File::Maintenance;
use warnings;
use strict;
use base qw(Class::Accessor);
use File::Find::Rule;
use File::Stat::OO;
use File::Copy;
use File::Path;
use File::Basename;
use DateTime;
use Carp;
use IO::Compress::Gzip qw($GzipError);
use IO::Compress::Zip qw($ZipError);
use IO::Compress::Bzip2 qw($Bzip2Error);

File::Maintenance->mk_accessors(
    qw(age test recurse directory pattern
        archive_directory)
);

use constant UNIT_MAP => {
    s => 'seconds',
    m => 'minutes',
    h => 'hours',
    d => 'days'
};

our $VERSION = '0.03';

sub purge {
    my $self = shift;

    foreach my $file ($self->get_files) {
        if ($self->test) {
            print "TEST: Purging $file\n";
        } else {
            unlink $file || croak("Unable to purge $file: $!");
        }
    }
}

sub gzip {
    my $self = shift;

    foreach my $file ($self->get_files) {
        if ($self->test) {
            print "TEST: gzipping $file\n";
        } else {
            IO::Compress::Gzip::gzip $file => $file . '.gz'
                or croak ("Unable to gzip $file: $GzipError");
            unlink $file || croak("Unable to purge $file: $!");
        }
    }
}

sub zip {
    my $self = shift;

    foreach my $file ($self->get_files) {
        if ($self->test) {
            print "TEST: zipping $file\n";
        } else {
            IO::Compress::Zip::zip $file => $file . '.zip'
                or croak ("Unable to zip $file: $ZipError");
            unlink $file || croak("Unable to purge $file: $!");
        }
    }
}

sub bzip2 {
    my $self = shift;

    foreach my $file ($self->get_files) {
        if ($self->test) {
            print "TEST: bzipping $file\n";
        } else {
            IO::Compress::Bzip2::bzip2 $file => $file . '.bz2'
                or croak ("Unable to bzip2 $file: $Bzip2Error");
            unlink $file || croak("Unable to purge $file: $!");
        }
    }
}

sub archive {
    my $self        = shift;
    my $archive_dir = $self->archive_directory
        || croak("Archive directory not specified");
    my $directory = $self->directory;
    my %dir_map;

    croak("You cannot archive to the source directory")
        if ($directory eq $archive_dir);

    foreach my $file ($self->get_files) {

        my $path;

        if ($self->recurse) {
            $path = dirname($file);
            $path =~ s/^$directory//g;
            $path =~ s/\/(.*)$/$1/g;
            $path = $archive_dir . '/' . $path;
        } else {
            $path = $archive_dir;
        }

        if ($self->test) {
            print "TEST: move $file to $path\n";
        } else {
            unless (-d $path) {
                mkpath $path || croak("Cannot make directory $path: $!");
            }
            move($file, $path) || croak("Cannot move $file to $path: $!");
        }
    }
}

sub get_files {
    my $self      = shift;
    my $directory = $self->directory || croak("Directory not specified");
    my $pattern   = $self->pattern || croak("Pattern not specified");
    my $epoch     = $self->_get_threshold_date();
    my @files;

    my $rule = File::Find::Rule->new;
    $rule->file;
    $rule->name($pattern);
    $rule->mtime("<$epoch");
    $rule->maxdepth(1) unless $self->recurse;
    @files = $rule->in($directory);

    return @files;
}

sub _get_threshold_date {
    my $self = shift;
    croak("Age parameter not specified") unless $self->age;
    my $date = DateTime->now(time_zone => 'local');
    if ($self->age =~ /^(\d+)(s|m|h|d)$/) {
        my $measure = $1;
        my $unit    = $2;

        $date->add(UNIT_MAP->{$unit} => -$measure);

        return $date->epoch;
    } else {
        croak("Invalid age");
    }
}

1;    # End of File::Maintenance