File Coverage

blib/lib/File/RotateLogs.pm

Criterion	Covered	Total	%
statement	80	86	93.0
branch	22	34	64.7
condition	3	6	50.0
subroutine	14	14	100.0
pod	0	4	0.0
total	119	144	82.6

package File::RotateLogs;

use strict;
use warnings;
use POSIX qw//;
use Fcntl qw/:DEFAULT/;
use Proc::Daemon;
use File::Spec;
use Mouse;
use Mouse::Util::TypeConstraints;

our $VERSION = '0.07';

subtype 'File::RotateLogs::Path'
    => as 'Str'
    => message { "This argument must be Str or Object that has a stringify method" };
coerce 'File::RotateLogs::Path'
    => from 'Object' => via {
        my $logfile = $_;
        if ( my $stringify = overload::Method( $logfile, '""' ) ) {
            return $stringify->($logfile);
        }
        $logfile;
    };

no Mouse::Util::TypeConstraints;

has 'logfile' => (
    is => 'ro',
    isa => 'File::RotateLogs::Path',
    required => 1,
    coerce => 1,
);

has 'linkname' => (
    is => 'ro',
    isa => 'File::RotateLogs::Path',
    required => 0,
    coerce => 1,
);

has 'rotationtime' => (
    is => 'ro',
    isa => 'Int',
    default => 86400
);

has 'maxage' => (
    is => 'ro',
    isa => 'Int',
    default => sub {
        warn "[INFO] File::RotateLogs: 'maxage' was not configured. RotateLogs doesn't remove any log files\n";
        return 0;
    },
);

has 'sleep_before_remove' => (
    is => 'ro',
    isa => 'Int',
    default => 3,
);

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


sub _gen_filename {
    my $self = shift;
    my $now = time;
    my $time = $now - (($now + $self->offset) % $self->rotationtime);
    return POSIX::strftime($self->logfile, localtime($time));
}

sub print {
    my ($self,$log) = @_;
    my $fname = $self->_gen_filename;

    my $fh;
    if ( $self->{fh} ) {
        if ( $fname eq $self->{fname} && $self->{pid} == $$ ) {
            $fh = delete $self->{fh};
        }
        else {
            $fh = delete $self->{fh};
            close $fh if $fh;
            undef $fh;
        }
    }

    unless ($fh) {
        my $is_new = ( ! -f $fname || ( $self->linkname && ! -l $self->linkname ) ) ? 1 : 0;
        open $fh, '>>:utf8:unix', $fname or die "Cannot open file($fname): $!";
        if ( $is_new ) {
            eval {
                $self->rotation($fname);
            };
            warn "failed rotation or symlink: $@" if $@;
        }
    }

    $fh->print($log)
        or die "Cannot write to $fname: $!";

    $self->{fh} = $fh;
    $self->{fname} = $fname;
    $self->{pid} = $$;
}

sub rotation {
    my ($self, $fname) = @_;

    my $lock = $fname .'_lock';
    sysopen(my $lockfh, $lock, O_CREAT|O_EXCL) or return;
    close($lockfh);
    if ( $self->linkname ) {
        my $symlink = $fname .'_symlink';
        symlink($fname, $symlink) or die $!;
        rename($symlink, $self->linkname) or die $!;
    }

    if ( ! $self->maxage ) {
        unlink $lock;
        return;
    }

    my $time = time;
    my @to_unlink = grep { $time - [stat($_)]->[9] > $self->maxage }
        glob($self->logfile_pattern);
    if ( ! @to_unlink ) {
        unlink $lock;
        return;
    }

    if ( $self->sleep_before_remove ) {
        $self->unlink_background(@to_unlink,$lock);
    }
    else {
        unlink $_ for @to_unlink;
        unlink $lock;
    }
}

sub logfile_pattern {
    my $self = shift;
    my $logfile = $self->logfile;
    $logfile =~ s!%[%+A-Za-z]!*!g;
    $logfile =~ s!\*+!*!g;
    $logfile;
}

sub unlink_background {
    my ($self, @files) = @_;
    my $daemon = Proc::Daemon->new();
    @files = map { File::Spec->rel2abs($_) } @files;
    if ( ! $daemon->Init ) {
        $0 = "$0 rotatelogs unlink worker";
        sleep $self->sleep_before_remove;
        unlink $_ for @files;
        POSIX::_exit(0);
    }
}

__PACKAGE__->meta->make_immutable();

1;
__END__