File Coverage

blib/lib/Test2/Harness/Util/File.pm

Criterion	Covered	Total	%
statement	63	65	96.9
branch	22	24	91.6
condition	9	11	81.8
subroutine	17	18	94.4
pod	0	11	0.0
total	111	129	86.0

package Test2::Harness::Util::File;
use strict;
use warnings;

our $VERSION = '0.001007';

use IO::Handle;

use Test2::Harness::Util();

use Carp qw/croak/;
use Fcntl qw/SEEK_SET SEEK_CUR/;

use Test2::Harness::Util::HashBase qw{ -name -_fh done -stamped -line_pos };

sub exists { -e $_[0]->{+NAME} }

sub decode { shift; $_[0] }
sub encode { shift; $_[0] }

sub init {
    my $self = shift;

    croak "'name' is a required attribute" unless $self->{+NAME};

    if (my $fh = delete $self->{fh}) {
        $fh->blocking(0);
        $self->{+_FH} = $fh;
    }
}

sub open_file {
    my $self = shift;
    return Test2::Harness::Util::open_file($self->{+NAME}, @_)
}

sub maybe_read {
    my $self = shift;
    return undef unless -e $self->{+NAME};
    return $self->read;
}

sub read {
    my $self = shift;
    my $out = Test2::Harness::Util::read_file($self->{+NAME});
    return $self->decode($out);
}

sub write {
    my $self = shift;
    return Test2::Harness::Util::write_file_atomic($self->{+NAME}, $self->encode(@_));
}

sub reset {
    my $self = shift;
    delete $self->{+_FH};
    delete $self->{+DONE};
    delete $self->{+LINE_POS};
    return;
}

sub fh {
    my $self = shift;
    return $self->{+_FH} if $self->{+_FH};

    $self->{+_FH} = Test2::Harness::Util::maybe_open_file($self->{+NAME}) or return undef;
    $self->{+_FH}->blocking(0);
    return $self->{+_FH};
}

sub read_line {
    my $self = shift;
    my %params = @_;

    my $pos = $params{from};
    $pos = $self->{+LINE_POS} ||= 0 unless defined $pos;

    my $fh = $self->fh or return undef;
    seek($fh,$pos,SEEK_SET) or die "Could not seek: $!";

    my $line = <$fh>;

    # No line, nothing to do
    return unless defined $line && length($line);

    # Partial line, hold off unless done
    return unless $self->{+DONE} || substr($line, -1, 1) eq "\n";

    my $new_pos = tell($fh);
    die "Failed to 'tell': $!" if $new_pos == -1;

    $line = $self->decode($line);

    $self->{+LINE_POS} = $new_pos unless defined $params{peek} || defined $params{from};
    return ($pos, $new_pos, $line);
}

1;

__END__