File Coverage

blib/lib/File/Rotate/Simple.pm

Criterion	Covered	Total	%
statement	97	105	92.3
branch	30	40	75.0
condition	14	15	93.3
subroutine	16	16	100.0
pod	2	2	100.0
total	159	178	89.3

package File::Rotate::Simple;

use v5.14;

use Moo 1.001000;
extends 'Exporter';

use Graph;
use List::Util 1.43, qw/ first /;
use Module::Runtime qw/ require_module /;
use Path::Tiny 0.015;
use Ref::Util qw/ is_blessed_ref /;
use Time::Seconds qw/ ONE_DAY /;
use Types::Standard -types;

use namespace::autoclean;

our $VERSION = 'v0.3.0';

# ABSTRACT: no-frills file rotation

# RECOMMEND PREREQ: Class::Load::XS
# RECOMMEND PREREQ: Ref::Util::XS
# RECOMMEND PREREQ: Type::Tiny::XS

our @EXPORT_OK = qw/ rotate_files /;


has age => (
    is      => 'ro',
    isa     => Int,
    default => 0,
);


has max => (
    is      => 'ro',
    isa     => Int,
    default => 0,
);


has file => (
    is       => 'ro',
    isa      => InstanceOf['Path::Tiny'],
    coerce   => \&path,
    required => 1,
);


has start_num => (
    is      => 'ro',
    isa     => Int,
    default => 1,
);


has extension_format => (
    is      => 'ro',
    isa     => Str,
    default => '.%#',
);


has replace_extension => (
    is  => 'ro',
    isa => Maybe[Str],
);


has if_missing => (
    is      => 'ro',
    isa     => Bool,
    default => 1,
);


has touch => (
    is      => 'ro',
    isa     => Bool,
    default => 0,
);


has time => (
    is      => 'rw',
    isa     => InstanceOf[qw/ Time::Piece Time::Moment DateTime /],
    lazy    => 1,
    default => sub { require_module('Time::Piece'); Time::Piece::localtime() },
    handles => {
        _strftime => 'strftime',
        _epoch    => 'epoch',
    },
);


sub rotate {
    my $self = shift;

    unless (is_blessed_ref $self) {
        my %args = (@_ == 1) ? %{ $_[0] } : @_;

        if (my $files = delete $args{files}) {
            foreach my $file (@{$files}) {
                $self->new( %args, file => $file )->rotate;
            }
            return;
        }

        $self = $self->new(%args);
    }

    my $max   = $self->max;
    my $age   = ($self->age)
        ? $self->_epoch - ($self->age * ONE_DAY)
        : 0;

    my @files = @{ $self->_build_files_to_rotate };

    my $index = scalar( @files );

    while ($index--) {

        my $file = $files[$index] or next;

        my $current = $file->{current};
        my $rotated    = $file->{rotated};

        unless (defined $rotated) {
            $current->remove;
            next;
        }

        if ($max && $index >= $max) {
            $current->remove;
            next;
        }

        if ($age && $current->stat->mtime < $age) {
            $current->remove;
            next;
        }

        die "Cannot move ${current} -> ${rotated}: file exists"
          if $rotated->exists;

        $current->move($rotated);
    }

    $self->file->touch if $self->touch;

    # TODO: chmod/chown arguments
}


sub _build_files_to_rotate {
    my ($self) = @_;

    my %files;

    my $num = $self->start_num;

    my $file = $self->_rotated_name( $num );
    if ($self->file->exists) {

        $files{ $self->file } = {
            current => $self->file,
            rotated => $file,
        };

    } else {

        return [ ] unless $self->if_missing;

    }

    my $max  = $self->max;
    while ($file->exists || ($max && $num <= $max)) {

        my $rotated = $self->_rotated_name( ++$num );

        last if $rotated eq $file;

        if ($file->exists) {
            $files{ $file } = {
                current => $file,
                rotated => (!$max || $num <= $max) ? $rotated : undef,
            };
        }

        $file = $rotated;

    }

    # Using a topoligical sort is probably overkill, but it allows us
    # to use more complicated filename rotation schemes in a subclass
    # without having to worry about file order.

    my $g = Graph->new;
    foreach my $file (values %files) {
        my $current = $file->{current};
        if (my $rotated = $file->{rotated}) {
            $g->add_edge( $current->stringify,
                          $rotated->stringify );
        } else {
            $g->add_vertex( $current->stringify );
        }
    }

    # Now check that there is not more than one file being rotated to
    # the same name.

    my %rotated;
    $rotated{$_->[1]}++ for ($g->edges);

    if (my $duplicate = first { $rotated{$_} > 1 } keys %rotated) {
        die "multiple files are rotated to '${duplicate}'";
    }

    die "dependency chain is cyclic"
      if $g->has_a_cycle;

    return [
        grep { defined $_ }
        map  { $files{$_} } $g->topological_sort()
        ];

}


sub _rotated_name {
    my ($self, $index) = @_;

    my $format = $self->extension_format;
    {
        no warnings 'uninitialized';
        $format =~ s/\%(\d+)*#/sprintf("\%0$1d", $index)/gea;
    }

    my $file      = $self->file->stringify;
    my $extension = ($format =~ /\%/) ? $self->_strftime($format) : $format;
    my $replace   = $self->replace_extension;

    if (defined $replace) {

        my $re = quotemeta($replace);
        return path($file =~ s/${re}$/${extension}/r );

    } else {

        return path( $file . $extension );

    }
}


sub rotate_files {
  __PACKAGE__->rotate( @_ );
}


1;

__END__