view release on metacpan or  search on metacpan

lib/File/Rotate/Simple.pm  view on Meta::CPAN

        _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.