package Test2::Harness::Util::File; use strict; use warnings; our $VERSION = '2.000006'; # TRIAL use IO::Handle; use Test2::Harness::Util(); use Carp qw/croak confess/; use Fcntl qw/SEEK_SET SEEK_CUR/; use Test2::Harness::Util::HashBase qw{ -name -_fh -_init_fh done -line_pos {+NAME} } sub decode { shift; $_[0] } sub encode { shift; $_[0] } sub init { my $self = shift; croak "'name' is a required attribute" unless $self->{+NAME}; $self->{+_INIT_FH} = delete $self->{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}); eval { $out = $self->decode($out); 1 } or confess "$self->{+NAME}: $@"; return $out; } sub rewrite { my $self = shift; return Test2::Harness::Util::write_file($self->{+NAME}, $self->encode(@_)); } 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}->{$$}; # Remove any other PID handles $self->{+_FH} = {}; if (my $fh = $self->{+_INIT_FH}) { $self->{+_FH}->{$$} = $fh; } else { $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}->{$$} || $self->fh or return undef; seek($fh,$pos,SEEK_SET) or die "Could not seek: $!" if eof($fh) || tell($fh) != $pos; 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; my $err = 0; local $@; unless (eval { $line = $self->decode($line); 1 }) { $err = $@ // 'error'; confess "$self->{+NAME} ($pos -> $new_pos): $err" unless $self->{+SKIP_BAD_DECODE}; warn "Skipping line that failed to decode: $err\n" if $self->{+SKIP_BAD_DECODE} > 1; $line = undef; } $self->{+LINE_POS} = $new_pos unless defined $params{peek} || defined $params{from}; return $line unless wantarray; return ($pos, $new_pos, $line, $err); } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Util::File - Utility class for manipulating a file. =head1 DESCRIPTION This is a utility class for file operations. This also serves as a base class for several file helpers. =head1 SYNOPSIS use Test2::Harness::Util::File; my $f = Test2::Harness::Util::File->new(name => '/path/to/file'); $f->write($content); my $fh = $f->open_file('<'); # Read, throw exception if it cannot read my $content = $f->read(); # Try to read, but do not throw an exception if it cannot be read. my $content_or_undef = $f->maybe_read(); my $line1 = $f->read_line(); my $line2 = $f->read_line(); ... =head1 ATTRIBUTES =over 4 =item $filename = $f->name; Get the filename. Must also be provided during construction. =item $bool = $f->done; True if read_line() has read every line. =back =head1 METHODS =over 4 =item $decoded = $f->decode($encoded) This is a no-op, it returns the argument unchanged. This is called by C and C. Subclasses can override this if the file contains encoded data. =item $encoded = $f->encode($decoded) This is a no-op, it returns the argument unchanged. This is called by C. Subclasses can override this if the file contains encoded data. =item $bool = $f->exists() Check if the file exists =item $content = $f->maybe_read() This will read the file if it can and return the content (all lines joined together as a single string). If the file cannot be read, or does not exist this will return undef. =item $fh = $f->open_file() =item $fh = $f->open_file($mode) Open a handle to the file. If no $mode is provided C<< '<' >> is used. =item $content = $f->read() This will read the file if it can and return the content (all lines joined together as a single string). If the file cannot be read, or does not exist this will throw an exception. =item $line = $f->read_line() Read a single line from the file, subsequent calls will read the next line and so on until the end of the file is reached. Reset with the C method. =item $f->reset() Reset the internal line iterator used by C. =item $f->write($content) This is an atomic-write. First $content will be written to a temporary file using C<< '>' >> mode. Then the temporary file will be renamed to the desired file name. Under the hood this uses C from L. =back =head1 SOURCE The source code repository for Test2-Harness can be found at L. =head1 MAINTAINERS =over 4 =item Chad Granum Eexodist@cpan.orgE =back =head1 AUTHORS =over 4 =item Chad Granum Eexodist@cpan.orgE =back =head1 COPYRIGHT Copyright Chad Granum Eexodist7@gmail.comE. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L =cut =pod =cut POD NEEDS AUDIT