File Coverage

blib/lib/File/Tail/App.pm

Criterion	Covered	Total	%
statement	18	100	18.0
branch	0	70	0.0
condition	0	25	0.0
subroutine	6	13	46.1
pod	1	3	33.3
total	25	211	11.8

package File::Tail::App;

use strict;
use warnings;

use File::Tail;
use Carp ();

sub import {
    my $caller = caller();
    no strict 'refs';
    *{ $caller . '::tail_app' } = \&tail_app;
}

$File::Tail::App::VERSION = '0.4';

sub File::Tail::seek_to {
    my($tail, $seek_to) = @_;
    Carp::croak 'argument to seek_to() must be all digits' if $seek_to !~ m/^\d+$/;
    $tail->{'curpos'} = sysseek $tail->{'handle'}, $seek_to, 0;
}

sub File::Tail::app {
    my($tail, $args_ref) = @_;

    $args_ref->{'line_handler'} = sub { print shift; }
        if !$args_ref->{'line_handler'};
    Carp::croak '"line_handler" must be an code ref'
        if ref $args_ref->{'line_handler'} ne 'CODE';

    $args_ref->{'verbose'} = 0 if !defined $args_ref->{'verbose'};

    my $lastrun_file = $args_ref->{'lastrun_file'};
    my $do_md5_check = $args_ref->{'do_md5_check'} || 0;

    my($previous_position, $file_ident, $md5_chk, $md5_len)
        = defined $lastrun_file ? _get_lastrun_data($tail->{'input'},
                                                    $lastrun_file,
                                                    $do_md5_check,
                                                    $tail)
                                : ('','','','');

    $args_ref->{'seek_on_zero'} = 1 if !exists $args_ref->{'seek_on_zero'};
    if(exists $args_ref->{'seek_to'} && defined $args_ref->{'seek_to'}) {
        if($args_ref->{'seek_to'} eq '0' && $args_ref->{'seek_on_zero'}) {
            $tail->seek_to($args_ref->{'seek_to'});
        }
        elsif($args_ref->{'seek_to'} =~ m/^\d+$/) {
            $tail->seek_to($args_ref->{'seek_to'});
        }
    }

    my $start_size   = -s $tail->{'input'};
    my $start_handle = $tail->{'handle'};

    $tail->seek_to($previous_position) if $previous_position ne $start_size
                                          && $previous_position ne '';

    while( defined( my $line = $tail->read() ) ) {
        my @stat = stat $tail->{'input'};
        my $replaced = 0;
        if(-s $tail->{'input'} < $start_size) {
            Carp::carp "$tail->{'input'} was truncated: " . sysseek($tail->{'handle'},0,1)
                if $args_ref->{'verbose'};
            $tail->seek_to(length $line);
            $replaced++;
        }
        elsif($do_md5_check && $md5_chk ne _get_md5_info($tail,
                                                       $md5_len,
                                                       $do_md5_check)) {
            Carp::carp "MD5 Check changed: " . sysseek($tail->{'handle'},0,1)
                if $args_ref->{'verbose'};
            $replaced++;
        }

        if($replaced) {
            $tail->seek_to(length $line);
            $start_size = $stat[7];
            $md5_len = $stat[7] < 42  ? $stat[7] : 42;
            $md5_chk = _get_md5_info($tail, $md5_len, $do_md5_check);
        }

        # do simple checks then tell them about it & reset some vars if needed
        if($stat[1] ne $file_ident && $file_ident) {
            Carp::carp "$tail->{'input'} was replaced: " . sysseek($tail->{'handle'},0,1)
                if $args_ref->{'verbose'};
            $file_ident = $stat[1];
        }

        if($start_handle ne $tail->{'handle'}) {
            # checking descriptor via fileno() is same check but numerically
            Carp::carp "descriptor/handle changed: " . sysseek($tail->{'handle'},0,1)
                if $args_ref->{'verbose'};
            $start_handle = $tail->{'handle'};
        }

        $args_ref->{'line_handler'}->($line);
        _set_lastrun_data(
                           sysseek($tail->{'handle'},0,1),
                           $file_ident,
                           $md5_chk,
                           $md5_len,
                           $lastrun_file
                         ) if defined $lastrun_file;
        Carp::carp "$tail->{'input'} is at : " . sysseek($tail->{'handle'},0,1)
            if $args_ref->{'verbose'} > 1;
    }
}

sub tail_app {
    my ($args_ref) = @_;

    Carp::croak 'tail_app() requires a hashref as its first argument'
        if ref $args_ref ne 'HASH';

    Carp::croak 'missing "new" key from tail_app arg' if !exists $args_ref->{'new'};
    Carp::croak '"new" must be an array ref' if ref $args_ref->{'new'} ne 'ARRAY';

    my $tail = File::Tail->new(@{ $args_ref->{'new'} })
        or Carp::croak "Could not create File::Tail object: $!";

    $tail->app({
        'line_handler' => $args_ref->{'line_handler'},
        'verbose'      => $args_ref->{'verbose'},
        'seek_to'      => $args_ref->{'seek_to'},
        'seek_on_zero' => $args_ref->{'seek_on_zero'},
        'lastrun_file' => $args_ref->{'lastrun_file'},
        'do_md5_check' => $args_ref->{'do_md5_check'},
    });
}

sub _get_lastrun_data {
    my($tail_file, $cur_file, $do_md5_check, $tail) = @_;

    my @stat              = stat $tail_file;
    my $previous_position = 0; # start at zero if 1st time ...
    my $cur_tail_ident    = $stat[1]; #:$stat[10]# or if file's changed
    my $_md5_len          = $stat[7] < 42  ? $stat[7] : 42;
    my $_md5_chk          = _get_md5_info($tail, $_md5_len, $do_md5_check);

    my($curpos, $logged_ident, $md5_chk, $md5_len) = ('','',$_md5_chk,$_md5_len);
    if(-e $cur_file) {
        open my $curat_fh, '<', $cur_file
            or Carp::croak "Could not read $cur_file: $!";
        chomp(my $first_line = <$curat_fh>);
        close $curat_fh;

        ($curpos, $logged_ident, $md5_chk, $md5_len) = split /-/, $first_line;
        $curpos = 0 if $logged_ident ne $cur_tail_ident;
        $previous_position = int($curpos);

        if($do_md5_check) {
           $md5_len = $_md5_len if !defined $md5_len || !$md5_len;
           $md5_chk = $_md5_chk if !defined $md5_chk || !$md5_chk;
        }
    }

    return ($previous_position, $cur_tail_ident, $md5_chk, $md5_len);
}

sub _set_lastrun_data {
    my($new_posi, $file_ident, $md5_chk, $md5_len, $cur_file) = @_;
    $md5_chk ||= 0;

    open my $curpos_fh, '>', $cur_file
        or Carp::croak "Could not write $cur_file: $!";
    print {$curpos_fh} qq($new_posi-$file_ident-$md5_chk-$md5_len);
    close $curpos_fh;
}

sub _get_md5_info {
    my($tail, $md5_len, $do_md5_check) = @_;

    return if !$do_md5_check;
    require Digest::MD5; # only do the module if needed

    my $data_to_md5 = ''; # to avoid uninitialized value warnings
    my $origpos = sysseek($tail->{'handle'},0,1);

    $tail->seek_to(0);
    sysread $tail->{'handle'}, $data_to_md5, $md5_len;
    $tail->seek_to($origpos);

    return Digest::MD5::md5_hex($data_to_md5);
}

1;

__END__