1package Test2::Harness::Util::File;
2use strict;
3use warnings;
4
5our $VERSION = '1.000082';
6
7use IO::Handle;
8
9use Test2::Harness::Util();
10
11use Carp qw/croak confess/;
12use Fcntl qw/SEEK_SET SEEK_CUR/;
13
14use Test2::Harness::Util::HashBase qw{ -name -_fh -_init_fh done -line_pos };
15
16sub exists { -e $_[0]->{+NAME} }
17
18sub decode { shift; $_[0] }
19sub encode { shift; $_[0] }
20
21sub init {
22    my $self = shift;
23
24    croak "'name' is a required attribute" unless $self->{+NAME};
25
26    $self->{+_INIT_FH} = delete $self->{fh};
27}
28
29sub open_file {
30    my $self = shift;
31    return Test2::Harness::Util::open_file($self->{+NAME}, @_)
32}
33
34sub maybe_read {
35    my $self = shift;
36    return undef unless -e $self->{+NAME};
37    return $self->read;
38}
39
40sub read {
41    my $self = shift;
42    my $out = Test2::Harness::Util::read_file($self->{+NAME});
43
44    eval { $out = $self->decode($out); 1 } or confess "$self->{+NAME}: $@";
45    return $out;
46}
47
48sub write {
49    my $self = shift;
50    return Test2::Harness::Util::write_file_atomic($self->{+NAME}, $self->encode(@_));
51}
52
53sub reset {
54    my $self = shift;
55    delete $self->{+_FH};
56    delete $self->{+DONE};
57    delete $self->{+LINE_POS};
58    return;
59}
60
61sub fh {
62    my $self = shift;
63    return $self->{+_FH}->{$$} if $self->{+_FH}->{$$};
64
65    # Remove any other PID handles
66    $self->{+_FH} = {};
67
68    if (my $fh = $self->{+_INIT_FH}) {
69        $self->{+_FH}->{$$} = $fh;
70    }
71    else {
72        $self->{+_FH}->{$$} = Test2::Harness::Util::maybe_open_file($self->{+NAME}) or return undef;
73    }
74
75    $self->{+_FH}->{$$}->blocking(0);
76    return $self->{+_FH}->{$$};
77}
78
79sub read_line {
80    my $self = shift;
81    my %params = @_;
82
83    my $pos = $params{from};
84    $pos = $self->{+LINE_POS} ||= 0 unless defined $pos;
85
86    my $fh = $self->{+_FH}->{$$} || $self->fh or return undef;
87    seek($fh,$pos,SEEK_SET) or die "Could not seek: $!"
88        if eof($fh) || tell($fh) != $pos;
89
90    my $line = <$fh>;
91
92    # No line, nothing to do
93    return unless defined $line && length($line);
94
95    # Partial line, hold off unless done
96    return unless $self->{+DONE} || substr($line, -1, 1) eq "\n";
97
98    my $new_pos = tell($fh);
99    die "Failed to 'tell': $!" if $new_pos == -1;
100
101    eval { $line = $self->decode($line); 1 } or confess "$self->{+NAME} ($pos -> $new_pos): $@";
102
103    $self->{+LINE_POS} = $new_pos unless defined $params{peek} || defined $params{from};
104    return ($pos, $new_pos, $line);
105}
106
1071;
108
109__END__
110
111=pod
112
113=encoding UTF-8
114
115=head1 NAME
116
117Test2::Harness::Util::File - Utility class for manipulating a file.
118
119=head1 DESCRIPTION
120
121This is a utility class for file operations. This also serves as a base class
122for several file helpers.
123
124=head1 SYNOPSIS
125
126    use Test2::Harness::Util::File;
127
128    my $f = Test2::Harness::Util::File->new(name => '/path/to/file');
129
130    $f->write($content);
131
132    my $fh = $f->open_file('<');
133
134    # Read, throw exception if it cannot read
135    my $content = $f->read();
136
137    # Try to read, but do not throw an exception if it cannot be read.
138    my $content_or_undef = $f->maybe_read();
139
140    my $line1 = $f->read_line();
141    my $line2 = $f->read_line();
142    ...
143
144=head1 ATTRIBUTES
145
146=over 4
147
148=item $filename = $f->name;
149
150Get the filename. Must also be provided during construction.
151
152=item $bool = $f->done;
153
154True if read_line() has read every line.
155
156=back
157
158=head1 METHODS
159
160=over 4
161
162=item $decoded = $f->decode($encoded)
163
164This is a no-op, it returns the argument unchanged. This is called by C<read>
165and C<read_line>. Subclasses can override this if the file contains encoded
166data.
167
168=item $encoded = $f->encode($decoded)
169
170This is a no-op, it returns the argument unchanged. This is called by C<write>.
171Subclasses can override this if the file contains encoded data.
172
173=item $bool = $f->exists()
174
175Check if the file exists
176
177=item $content = $f->maybe_read()
178
179This will read the file if it can and return the content (all lines joined
180together as a single string). If the file cannot be read, or does not exist
181this will return undef.
182
183=item $fh = $f->open_file()
184
185=item $fh = $f->open_file($mode)
186
187Open a handle to the file. If no $mode is provided C<< '<' >> is used.
188
189=item $content = $f->read()
190
191This will read the file if it can and return the content (all lines joined
192together as a single string). If the file cannot be read, or does not exist
193this will throw an exception.
194
195=item $line = $f->read_line()
196
197Read a single line from the file, subsequent calls will read the next line and
198so on until the end of the file is reached. Reset with the C<reset()> method.
199
200=item $f->reset()
201
202Reset the internal line iterator used by C<read_line()>.
203
204=item $f->write($content)
205
206This is an atomic-write. First $content will be written to a temporary file
207using C<< '>' >> mode. Then the temporary file will be renamed to the desired
208file name. Under the hood this uses C<write_file_atomic()> from
209L<Test2::Harness::Util>.
210
211=back
212
213=head1 SOURCE
214
215The source code repository for Test2-Harness can be found at
216F<http://github.com/Test-More/Test2-Harness/>.
217
218=head1 MAINTAINERS
219
220=over 4
221
222=item Chad Granum E<lt>exodist@cpan.orgE<gt>
223
224=back
225
226=head1 AUTHORS
227
228=over 4
229
230=item Chad Granum E<lt>exodist@cpan.orgE<gt>
231
232=back
233
234=head1 COPYRIGHT
235
236Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>.
237
238This program is free software; you can redistribute it and/or
239modify it under the same terms as Perl itself.
240
241See F<http://dev.perl.org/licenses/>
242
243=cut
244