File Coverage

blib/lib/Logfile/Tail/Switch.pm

Criterion	Covered	Total	%
statement	65	67	97.0
branch	30	36	83.3
condition	4	5	80.0
subroutine	8	8	100.0
pod	2	2	100.0
total	109	118	92.3

package Logfile::Tail::Switch;

our $DATE = '2019-01-30'; # DATE
our $VERSION = '0.004'; # VERSION

use 5.010001;
use strict;
use warnings;

use Time::HiRes 'time';

our $WARN_NO_MATCH = 1;

sub new {
    my ($class, %args) = @_;

    my $self = {
        _cur_file  => {},
        _cur_fh    => {},
        _pending   => {},
        check_freq => 2,
        tail_new   => 0,
    };

    if (defined(my $globs = delete $args{globs})) {
        ref($globs) eq 'ARRAY' or die "globs must be arrayref";
        $self->{globs} = $globs;
    } else {
        die "Please specify globs";
    }
    if (defined(my $check_freq = delete $args{check_freq})) {
        $self->{check_freq} = $check_freq;
    }
    if (defined(my $tail_new = delete $args{tail_new})) {
        $self->{tail_new} = $tail_new;
    }
    die "Unknown arguments: ".join(", ", keys %args) if keys %args;

    bless $self, $class;
}

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

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

sub _getline {
    my ($self, $fh) = @_;

    my $size = -s $fh;
    my $pos = tell $fh;
    #say "D:size=<$size>, pos=<$pos>";
    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->{check_freq};
        $self->{_last_check_time} = $now;
        #say "D: checking for newer file";
        for my $glob (@{ $self->{globs} }) {
            my @files = sort glob($glob);
            #say "D: files matching glob: ".join(", ", @files);
            unless (@files) {
                warn "No files matched '$glob'" if $WARN_NO_MATCH;
                next;
            }
            if (defined $self->{_cur_fh}{$glob}) {
                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
                    if ($_ gt $self->{_cur_file}{$glob}) {
                        #say "D: there is a newer file: $_";
                        $self->{_pending}{$glob}{$_} = 1;
                    }
                }
            } else {
                # this is our first time, pick the newest file in the pattern
                # and tail it.
                $self->_switch($glob, $files[-1], 1);
            }
        }
    }

    my $line = '';
    for my $glob (@{ $self->{globs} }) {
        my $fh = $self->{_cur_fh}{$glob};
        next unless $fh;
        $line = $self->_getline($fh);
        if (length $line) {
            last;
        } elsif (keys %{$self->{_pending}{$glob}}) {
            # switch to a newer named file
            my @files = sort keys %{$self->{_pending}{$glob}};
            $self->_switch($glob, $files[0], $self->{tail_new});
            delete $self->{_pending}{$glob}{$files[0]};
            $line = $self->_getline($self->{_cur_fh}{$glob});
            last if length $line;
        }
    }
    $line;
}

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

__END__