File Coverage

blib/lib/File/Tail/FAM.pm

Criterion	Covered	Total	%
statement	1	3	33.3
branch			n/a
condition			n/a
subroutine	1	1	100.0
pod			n/a
total	2	4	50.0

###########################################
package File::Tail::FAM;
###########################################
use SGI::FAM;
use Log::Log4perl qw(:easy);
use strict;
use warnings;

our $VERSION = "0.02";

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

    my $self = {
        fam => SGI::FAM->new(),
        %options,
    };

    LOGDIE "Mandatory parameter missing: file" unless
        exists $self->{file};

    LOGDIE "File $self->{file} doesn't exist" unless
        -f $self->{file};

    LOGDIE "File $self->{file} isn't readable" unless
        -r $self->{file};

    $self->{fam}->monitor($self->{file}) or
        LOGDIE "Monitoring $self->{file} failed";

        # Block until we get the 'exist' event to make
        # sure the monitor is in place
    my $e = $self->{fam}->next_event();

    bless $self, $class;

    $self->file_open();
    $self->checkpoint(2);

    return $self;
}

###########################################
sub read_nonblock {
###########################################
    my($self) = @_;

    return $self->read(1);
}

###########################################
sub poll_pending {
# The test suite uses this to avoid race conditions
###########################################
    my($self) = @_;

    while(! $self->{fam}->pending()) {
        select undef, undef, undef, 0.1;
    }
}

###########################################
sub checkpoint {
###########################################
    my($self, $whence) = @_;

    DEBUG "Checkpoint on file $self->{file}";

    if(defined $self->{offset}) {
        my $new_size = -s "$self->{file}";

        if($new_size < $self->{offset}) {
            # File truncated, re-read
            DEBUG "Assuming truncated file";
            $self->file_close();
            $self->file_open(0);
        }
    }

        # Seek to $whence
    seek $self->{fh}, 0, $whence;
    $self->{offset} = tell $self->{fh};

    DEBUG "Offset on $self->{file} is $self->{offset}";
}

###########################################
sub read {
###########################################
    my($self, $nonblock) = @_;

    while(1) {

        if($nonblock) {
            unless($self->{fam}->pending()) {
                DEBUG "No events pending in non-blocking read";
                return undef;
            }
        }

        DEBUG "Blocking for next event";
        my $e = $self->{fam}->next_event();
        DEBUG "Got event: ", $e->type();

        my $data;

        if($e->type() eq "create") {
            $self->checkpoint(0);
            $data = $self->read_more();
            redo unless defined $data;
            return $data;
        } elsif( $e->type() eq "change" ) {
            $data = $self->read_more();
            redo unless defined $data;
            return $data;
        }
    }
}

###########################################
sub read_more {
###########################################
    my($self) = @_;

       # Lift EOF
    seek $self->{fh}, 0, 1;

    local $/;
    $/ = undef;

    my $fh = $self->{fh};
    my $data = <$fh>;

    if(defined $data) {
        DEBUG "Found data: '$data'";
    } else {
            # This can happen if we get several change events
            # in a row, no problem
        $self->checkpoint(2);
        return undef;
    }

    $self->{offset} = tell $self->{fh};

    return $data;
}

##################################################
sub file_close {
##################################################
    my($self) = @_;

    DEBUG "Closing file $self->{file}";

    undef $self->{fh};
}

##################################################
sub file_open {
##################################################
    my($self, $whence) = @_;

    $whence = 2 unless defined $whence;

    DEBUG "Opening file $self->{file}";

    my $fh = do { local *FH; *FH; };

    open $fh, "$self->{file}" or
        LOGDIE "Can't open $self->{file} ($!)";

    $self->{fh} = $fh;

        # Seek to EOF
    seek $self->{fh}, 0, $whence;
    $self->{offset} = tell $self->{fh};

    DEBUG "Setting offset to $self->{offset}";
}

1;

__END__