File Coverage

blib/lib/Logfile/Tail/Switch.pm

Criterion	Covered	Total	%
statement	50	51	98.0
branch	19	22	86.3
condition	11	12	91.6
subroutine	8	8	100.0
pod	2	2	100.0
total	90	95	94.7

package Logfile::Tail::Switch;

our $DATE = '2017-06-09'; # DATE
our $VERSION = '0.002'; # VERSION

use 5.010001;
use strict;
use warnings;

use Time::HiRes 'time';

sub new {
    my ($class, $glob, $opts) = @_;

    defined($glob) or die "Please specify glob";
    $opts //= {};

    $opts->{check_freq} //= 5;

    my $self = {
        glob => $glob,
        opts => $opts,
        _cur_file => undef,
        _cur_fh   => undef,
        _pending  => {},
    };

    bless $self, $class;
}

sub _switch {
    my ($self, $filename, $seek_end) = @_;

    #say "D: opening $filename";
    $self->{_cur_file} = $filename;
    open my $fh, "<", $filename or die "Can't open $filename: $!";
    seek $fh, 0, 2 if $seek_end;
    $self->{_cur_fh} = $fh;
}

sub _getline {
    my $self = shift;

    my $fh = $self->{_cur_fh};
    my $size = -s $fh;
    my $pos = tell $fh;
    if ($pos == $size) {
        # we are still at the end of file, return empty string
        return '';
    } elsif ($pos > $size) {
        # file reduced in size, it probably means it has been rotated, start
        # from the beginning
        seek $fh, 0, 0;
    } else {
        # there are new content to read after our position
    }
    return(<$fh> // '');
}

sub getline {
    my $self = shift;

    my $now = time();

  CHECK_NEWER_FILES:
    {
        last if $self->{_last_check_time} &&
            $self->{_last_check_time} >= $now - $self->{opts}{check_freq};
        #say "D: checking for newer file";
        my @files = sort glob($self->{glob});
        #say "D: files matching glob: ".join(", ", @files);
        $self->{_last_check_time} = $now;
        last unless @files;
        if (defined $self->{_cur_fh}) {
            for (@files) {
                # there is a newer file than the current one, add to the pending
                # list of files to be read after the current one
                #say "D: there is a newer file: $_";
                $self->{_pending}{$_} = 1
                    if $_ gt $self->{_cur_file};
            }
        } else {
            # this is our first time, pick the newest file in the pattern and
            # tail it.
            $self->_switch($files[-1], 1);
        }
    }

    # we don't have any matching files
    return '' unless $self->{_cur_fh};

    my $line = $self->_getline;
    if (!length($line) && keys %{$self->{_pending}}) {
        # switch to a newer named file
        my @files = sort keys %{$self->{_pending}};
        $self->_switch($files[0]);
        delete $self->{_pending}{$files[0]};
        $line = $self->_getline;
    }
    $line;
}

1;
# ABSTRACT: Tail a file, but switch when another file with newer name appears

__END__