line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package IO::ReadHandle::Include; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
48437
|
use 5.006; |
|
1
|
|
|
|
|
3
|
|
4
|
1
|
|
|
1
|
|
4
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
16
|
|
5
|
1
|
|
|
1
|
|
3
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
31
|
|
6
|
|
|
|
|
|
|
|
7
|
1
|
|
|
1
|
|
5
|
use Carp; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
47
|
|
8
|
1
|
|
|
1
|
|
373
|
use Path::Class qw(file); |
|
1
|
|
|
|
|
30100
|
|
|
1
|
|
|
|
|
54
|
|
9
|
1
|
|
|
1
|
|
7
|
use Scalar::Util qw(blessed reftype); |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
34
|
|
10
|
1
|
|
|
1
|
|
4
|
use Symbol qw(gensym); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
33
|
|
11
|
|
|
|
|
|
|
|
12
|
1
|
|
|
1
|
|
4
|
use parent qw(IO::Handle); |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
3
|
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
=head1 NAME |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
B - A filehandle for reading with include |
17
|
|
|
|
|
|
|
facility |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
=head1 VERSION |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
Version 1.1 |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
=cut |
24
|
|
|
|
|
|
|
|
25
|
1
|
|
|
1
|
|
376
|
use version; our $VERSION = version->declare('v1.1'); |
|
1
|
|
|
|
|
1398
|
|
|
1
|
|
|
|
|
4
|
|
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
=head1 SYNOPSIS |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
use IO::ReadHandle::Include; |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
open $ofh1, '>', 'extra.txt'; |
32
|
|
|
|
|
|
|
print $ofh1 "Extra, extra! Read all about it!\n"; |
33
|
|
|
|
|
|
|
close $ofh1; |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
open $ofh2, '>', 'file.txt'; |
36
|
|
|
|
|
|
|
print $ofh2 <
|
37
|
|
|
|
|
|
|
The paperboy said: |
38
|
|
|
|
|
|
|
#include extra.txt |
39
|
|
|
|
|
|
|
and then he ran off. |
40
|
|
|
|
|
|
|
EOD |
41
|
|
|
|
|
|
|
close $ofh2; |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
$ifh = IO::ReadHandle::Include |
44
|
|
|
|
|
|
|
->new({ source => 'file.txt', |
45
|
|
|
|
|
|
|
include => qr/^#include (.*)$/) }); |
46
|
|
|
|
|
|
|
print while <$ifh>; |
47
|
|
|
|
|
|
|
close $ifh; |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
# prints: |
50
|
|
|
|
|
|
|
# |
51
|
|
|
|
|
|
|
# The paperboy said: |
52
|
|
|
|
|
|
|
# Extra, extra! Read all about it! |
53
|
|
|
|
|
|
|
# and then he ran off. |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
=head1 DESCRIPTION |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
This module produces filehandles for reading from a source text file |
58
|
|
|
|
|
|
|
and any number of included files, identified from include directives |
59
|
|
|
|
|
|
|
found in the read text. |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
Filehandle functions/methods associated with writing cannot be used |
62
|
|
|
|
|
|
|
with an B object. |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
=head2 INCLUDE DIRECTIVES AND THE READLINE FUNCTION |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
The include directives are identified through a regular expression |
67
|
|
|
|
|
|
|
(L). |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
$ifh = IO::ReadHandle::Include->new({ include => $regex, ... }); |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
If the text read from the source file matches the regular expression, |
72
|
|
|
|
|
|
|
then, in the output, the part of the text matching the regular |
73
|
|
|
|
|
|
|
expression is replaced with the contents of the identified include |
74
|
|
|
|
|
|
|
file, if that include file exists. This works recursively: The |
75
|
|
|
|
|
|
|
included file can itself include other files, using the same format |
76
|
|
|
|
|
|
|
for include directives. If an include file does not exist, then the |
77
|
|
|
|
|
|
|
include directive naming that file is not replaced. |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
The include file is identified by the text corresponding to a |
80
|
|
|
|
|
|
|
particular capture group (C<< (?...) >> or C<$1>) of the |
81
|
|
|
|
|
|
|
regular expression. For example, given the two lines of text |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
#include foo.txt |
84
|
|
|
|
|
|
|
#include "bar.txt" |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
the regular expression |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
qr/^#include (?|"(.*?)"|(.*))$/ |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
identifies C and C as the include files through |
91
|
|
|
|
|
|
|
C<$1>, and the regular expression |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
qr/^#include ("?)(?.*?)\g{1}$/ |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
does the same through C<$+{include}>. |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
The text is transformed if a transformation code reference is defined |
98
|
|
|
|
|
|
|
(L). The final text is interpreted as the path to the |
99
|
|
|
|
|
|
|
file to include at this point. |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
Text is read from the source file and the included files piece by |
102
|
|
|
|
|
|
|
piece. If you're unlucky, then the piece most recently read ends in |
103
|
|
|
|
|
|
|
the middle of an include directive, and then the current module cannot |
104
|
|
|
|
|
|
|
detect that include directive because it isn't complete yet. |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
To resolve this problem, the current module assumes that if the |
107
|
|
|
|
|
|
|
regular expression matches the input record separator, then it must be |
108
|
|
|
|
|
|
|
at the very end of the regular expression. If any piece of text |
109
|
|
|
|
|
|
|
ending with the input record separator does not match the regular |
110
|
|
|
|
|
|
|
expression, then the current module concludes that that piece of text |
111
|
|
|
|
|
|
|
does not contain an include directive. |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
This means that an include directive should not contain an input |
114
|
|
|
|
|
|
|
record separator L<$E|perlvar/"$/"> (by default a newline), |
115
|
|
|
|
|
|
|
except perhaps at the very end. Otherwise the include directive may |
116
|
|
|
|
|
|
|
not always be recognized. |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
This works well for the L function, |
119
|
|
|
|
|
|
|
for the L and L methods, and for the angle |
120
|
|
|
|
|
|
|
brackets operator (C<< <$ih> >>), which read text up to and including |
121
|
|
|
|
|
|
|
the input record separator (or the end of the data, whichever comes |
122
|
|
|
|
|
|
|
first). |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
=head2 INCLUDE DIRECTIVES AND THE READ FUNCTION |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
Function L and method L read up to a |
127
|
|
|
|
|
|
|
user-selected number of characters from the source. The read chunk of |
128
|
|
|
|
|
|
|
text does not necessarily end with the input record separator, so it |
129
|
|
|
|
|
|
|
might end in the middle of an include directive, and then the include |
130
|
|
|
|
|
|
|
directive cannot be recognized. |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
To resolve this problem, the L function/method when called on |
133
|
|
|
|
|
|
|
an IO::ReadHandle::Include object by default quietly read beyond the |
134
|
|
|
|
|
|
|
requested number of characters until the next input record separator |
135
|
|
|
|
|
|
|
or the end of the data is seen, so it can properly detect and resolve |
136
|
|
|
|
|
|
|
any include directives. It then returns only up to the requested |
137
|
|
|
|
|
|
|
number of characters, and remembers the remainder for the next call. |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
This means that if the source file or an include file contains no |
140
|
|
|
|
|
|
|
input record separator at all and is read using the L |
141
|
|
|
|
|
|
|
function/method, then the entire contents of the source and/or include |
142
|
|
|
|
|
|
|
file are read into memory at once. |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
When using the L function/method to read the text, you don't |
145
|
|
|
|
|
|
|
know beforehand how many lines of text you get. This can be a problem |
146
|
|
|
|
|
|
|
if the transformation of include path names from later lines of text |
147
|
|
|
|
|
|
|
may depend on something seen in earlier lines of text. Any change |
148
|
|
|
|
|
|
|
that gets made to the transformation (via L) can apply |
149
|
|
|
|
|
|
|
only to include directives that haven't been resolved yet -- so they |
150
|
|
|
|
|
|
|
cannot apply to any include directives that were resolved while |
151
|
|
|
|
|
|
|
processing the L call that produced the text that indicates the |
152
|
|
|
|
|
|
|
need to change the transformation. |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
In such a case, use the L method to indicate that |
155
|
|
|
|
|
|
|
you want L to return text that does not extend beyond the first |
156
|
|
|
|
|
|
|
input record separator -- i.e., at most one line of text. You may |
157
|
|
|
|
|
|
|
then get fewer characters from a call to L than you asked for, |
158
|
|
|
|
|
|
|
even if there is still more text in the source. |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
=head2 LINE NUMBER |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
The value of the line number special variable L<$.|perlvar/$.> is |
163
|
|
|
|
|
|
|
supposed to be equal to the number of lines read through the last used |
164
|
|
|
|
|
|
|
filehandle, but for an B, that value is not |
165
|
|
|
|
|
|
|
trustworthy. It takes a lot more bookkeeping to make it trustworthy. |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
=head2 PRIVATE FIELDS |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
B objects support the use of private fields |
170
|
|
|
|
|
|
|
stored within the object. L sets such a field, |
171
|
|
|
|
|
|
|
L queries it, and L removes it again. |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
These fields can be used, for example, to pass information from the |
174
|
|
|
|
|
|
|
application using the object to the include path transformation code |
175
|
|
|
|
|
|
|
(L) to guide the transformation. |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
The fields are private in the sense that an B |
178
|
|
|
|
|
|
|
object does not itself access them, so they're all yours. |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
=head1 SUBROUTINES/METHODS |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
=head2 new |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
$ifh = IO::ReadHandle::Include->new({ source => $source, |
185
|
|
|
|
|
|
|
include => $regex, |
186
|
|
|
|
|
|
|
transform => $coderef }); |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
Creates an object that can be used as a filehandle for reading, with |
189
|
|
|
|
|
|
|
include files. |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
The C<$source> is the path to the main file to read from, if it is a |
192
|
|
|
|
|
|
|
scalar. If it is a filehandle, then the main contents are read from |
193
|
|
|
|
|
|
|
that filehandle. |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
The C<$regex> is a regular expression that identifies an include |
196
|
|
|
|
|
|
|
directive. If the regular expression defines a capture group called |
197
|
|
|
|
|
|
|
C (C<< (?...) >>), then its value identifies the |
198
|
|
|
|
|
|
|
file to include. Otherwise, the first capture group identifies the |
199
|
|
|
|
|
|
|
file to include. If the include file path is relative, then it is |
200
|
|
|
|
|
|
|
interpreted relative to the path of the file from which the include |
201
|
|
|
|
|
|
|
directive was read. |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
The C<$coderef>, if specified, must be a reference to code, |
204
|
|
|
|
|
|
|
i.e. C<\&foo> for a reference to function C, or C |
205
|
|
|
|
|
|
|
for a reference to an anonymous block of code. That code is used to |
206
|
|
|
|
|
|
|
transform the path name of the include file. The reference gets |
207
|
|
|
|
|
|
|
called as |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
$path = $coderef->($path, $ifh); |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
where C<$path> is the path name extracted from the include directive, |
212
|
|
|
|
|
|
|
and C<$ifh> is the B object. You can use the |
213
|
|
|
|
|
|
|
latter, for example, to access the private area of the |
214
|
|
|
|
|
|
|
B to assist the transformation |
215
|
|
|
|
|
|
|
(L). The result of executing the code reference is used |
216
|
|
|
|
|
|
|
as the path of the include file to open. |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
=cut |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
sub new { |
221
|
0
|
|
|
0
|
1
|
|
my ( $class, @args ) = @_; |
222
|
0
|
|
0
|
|
|
|
my $self = bless gensym(), ref($class) || $class; |
223
|
0
|
|
|
|
|
|
tie *$self, $self; |
224
|
0
|
|
|
|
|
|
return $self->open(@args); |
225
|
|
|
|
|
|
|
} |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
# for Tie::Handle |
228
|
|
|
|
|
|
|
sub TIEHANDLE { |
229
|
0
|
0
|
|
0
|
|
|
return $_[0] if ref( $_[0] ); |
230
|
0
|
|
|
|
|
|
my ( $class, @args ) = @_; |
231
|
0
|
|
|
|
|
|
my $self = bless gensym(), $class; |
232
|
0
|
|
|
|
|
|
return $self->open(@args); |
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
# gets the specified field from the module's hash in the GLOB's hash |
236
|
|
|
|
|
|
|
# part |
237
|
|
|
|
|
|
|
sub _get { |
238
|
0
|
|
|
0
|
|
|
my ( $self, $field ) = @_; |
239
|
0
|
|
|
|
|
|
my $pkg = __PACKAGE__; |
240
|
0
|
|
|
|
|
|
return *$self->{$pkg}->{$field}; |
241
|
|
|
|
|
|
|
} |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
# sets the specified field in the module's hash in the GLOB's hash |
244
|
|
|
|
|
|
|
# part to the specified value |
245
|
|
|
|
|
|
|
sub _set { |
246
|
0
|
|
|
0
|
|
|
my ( $self, $field, $value ) = @_; |
247
|
0
|
|
|
|
|
|
my $pkg = __PACKAGE__; |
248
|
0
|
|
|
|
|
|
my $old_value = *$self->{$pkg}->{$field}; |
249
|
0
|
|
|
|
|
|
*$self->{$pkg}->{$field} = $value; |
250
|
0
|
|
|
|
|
|
return $self; |
251
|
|
|
|
|
|
|
} |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
# if the $field is defined, then deletes the specified field from the |
254
|
|
|
|
|
|
|
# module's hash in the object's hash part. Otherwise, deletes the |
255
|
|
|
|
|
|
|
# module's hash from the GLOB's hash part. |
256
|
|
|
|
|
|
|
sub _delete { |
257
|
0
|
|
|
0
|
|
|
my ( $self, $field ) = @_; |
258
|
0
|
|
|
|
|
|
my $pkg = __PACKAGE__; |
259
|
0
|
0
|
|
|
|
|
if ( defined $field ) { |
260
|
0
|
|
|
|
|
|
delete *$self->{$pkg}->{$field}; |
261
|
|
|
|
|
|
|
} |
262
|
|
|
|
|
|
|
else { |
263
|
0
|
|
|
|
|
|
delete *$self->{$pkg}; |
264
|
|
|
|
|
|
|
} |
265
|
0
|
|
|
|
|
|
return $self; |
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
=head2 close |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
$ifh->close; |
271
|
|
|
|
|
|
|
close $ifh; |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
Closes the B. Closes any internal |
274
|
|
|
|
|
|
|
filehandles that the instance was using, but if the main source was |
275
|
|
|
|
|
|
|
passed as a filehandle then that filehandle is not closed. |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
=cut |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
# for Tie::Handle, close the handle |
280
|
|
|
|
|
|
|
sub CLOSE { |
281
|
0
|
|
|
0
|
|
|
my ($self) = @_; |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
# close any included files |
284
|
0
|
|
|
|
|
|
1 while $self->_end_include; |
285
|
|
|
|
|
|
|
|
286
|
0
|
0
|
|
|
|
|
if ( reftype( $self->_get('main_source') ) eq '' ) { |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
# the main source was passed as a scalar, so we opened its |
289
|
|
|
|
|
|
|
# filehandle |
290
|
0
|
|
|
|
|
|
my $ifh = $self->_get('ifh'); |
291
|
0
|
0
|
|
|
|
|
if ($ifh) { |
292
|
0
|
|
|
|
|
|
close $ifh; |
293
|
|
|
|
|
|
|
} |
294
|
|
|
|
|
|
|
} # otherwise the main source was passed as a filehandle; we don't |
295
|
|
|
|
|
|
|
# close it because we did not open it, either. |
296
|
0
|
|
|
|
|
|
$self->_delete; |
297
|
|
|
|
|
|
|
} |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
=head2 current_source |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
$current_source = $ifh->current_source; |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
Returns text describing the main source or include file that the next |
304
|
|
|
|
|
|
|
input through B will come from, or (at the |
305
|
|
|
|
|
|
|
end of the stream) that the last input came from. |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
For a main source specified as a path name, or for an included file, |
308
|
|
|
|
|
|
|
returns the path name. |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
For a main source specified as a filehandle, returns the result of |
311
|
|
|
|
|
|
|
calling the C method on that filehandle, unless it |
312
|
|
|
|
|
|
|
returns the undefined value or the filehandle doesn't support the |
313
|
|
|
|
|
|
|
C method, in which case the current method returns the |
314
|
|
|
|
|
|
|
stringified version of the filehandle. |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
NOTE: The result of this method is not always accurate. Currently, it |
317
|
|
|
|
|
|
|
in fact describes the source that data will be I next, but |
318
|
|
|
|
|
|
|
that is not always the source of the data that is I next, |
319
|
|
|
|
|
|
|
because in some circumstances data gets buffered and returned only |
320
|
|
|
|
|
|
|
later, when the source from where it came may already have run dry. |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
The results of this method are only accurate if (1) all of the data is |
323
|
|
|
|
|
|
|
read by lines, and (2) the include directive always comes at the very |
324
|
|
|
|
|
|
|
end of a line. |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
Making this method always accurate requires a lot more internal |
327
|
|
|
|
|
|
|
bookkeeping. |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
=cut |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
sub current_source { |
332
|
0
|
|
|
0
|
1
|
|
my ($self) = @_; |
333
|
0
|
|
|
|
|
|
my $source = $self->_get('source'); |
334
|
0
|
0
|
|
|
|
|
return unless defined $source; |
335
|
0
|
0
|
|
|
|
|
if ( ref $source ) { |
336
|
0
|
0
|
|
|
|
|
if ( reftype($source) eq 'GLOB' ) { |
337
|
0
|
|
|
|
|
|
my $s = eval { $source->current_source }; |
|
0
|
|
|
|
|
|
|
338
|
0
|
0
|
|
|
|
|
return defined($s) ? $s : "$source"; |
339
|
|
|
|
|
|
|
} |
340
|
|
|
|
|
|
|
} |
341
|
0
|
|
|
|
|
|
return $source; |
342
|
|
|
|
|
|
|
} |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
=head2 eof |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
$end_of_data = eof $ifh; |
347
|
|
|
|
|
|
|
$end_of_data = $ifh->eof; |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
Returns 1 when there is no (more) data to read through the |
350
|
|
|
|
|
|
|
B, and C<''> otherwise, similar to |
351
|
|
|
|
|
|
|
L and L. |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
=cut |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
sub eof { |
356
|
0
|
|
|
0
|
1
|
|
return EOF(@_); |
357
|
|
|
|
|
|
|
} |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
# for Tie::Handle: are we at the end of the data? |
360
|
|
|
|
|
|
|
sub EOF { |
361
|
0
|
|
|
0
|
|
|
my ($self) = @_; |
362
|
0
|
|
|
|
|
|
my $buffer = $self->_get('buffer'); |
363
|
0
|
0
|
|
|
|
|
return '' if $buffer; |
364
|
|
|
|
|
|
|
|
365
|
0
|
|
|
|
|
|
my $ifh = $self->_get('ifh'); |
366
|
0
|
0
|
0
|
|
|
|
return '' if $ifh # we've started reading |
367
|
|
|
|
|
|
|
&& not( $ifh->eof ); # and aren't at the end of the current source |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
# If we get here, then either we hadn't started reading yet, or else |
370
|
|
|
|
|
|
|
# we're at the end of the current source. |
371
|
|
|
|
|
|
|
|
372
|
0
|
0
|
|
|
|
|
if ($ifh) { # we had started reading already, |
373
|
|
|
|
|
|
|
# so the current source is exhausted. |
374
|
0
|
0
|
|
|
|
|
if ( not $self->_end_include ) { |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
# we were reading from the main file |
377
|
0
|
|
|
|
|
|
return 1; |
378
|
|
|
|
|
|
|
} # otherwise we were inside an include file and have now reverted |
379
|
|
|
|
|
|
|
# to the including file, and need to check if it is at EOF |
380
|
|
|
|
|
|
|
} |
381
|
|
|
|
|
|
|
else { # haven't opened the main source yet, Do it now and |
382
|
|
|
|
|
|
|
# initialize appropriately |
383
|
0
|
|
|
|
|
|
my $source = $self->_get('source'); |
384
|
0
|
0
|
0
|
|
|
|
if ( ref($source) && reftype($source) eq 'GLOB' ) { |
385
|
0
|
|
|
|
|
|
$ifh = $source; |
386
|
|
|
|
|
|
|
} |
387
|
|
|
|
|
|
|
else { |
388
|
0
|
0
|
|
|
|
|
CORE::open $ifh, '<', $source |
389
|
|
|
|
|
|
|
or croak "Cannot open '$source' for reading: $!"; |
390
|
|
|
|
|
|
|
} |
391
|
0
|
|
|
|
|
|
$self->_set( ifh => $ifh )->_set( ifhs => [] )->_set( suffixes => [] ) |
392
|
|
|
|
|
|
|
->_set( sources => [] )->_set( buffer => '' ); |
393
|
|
|
|
|
|
|
} |
394
|
0
|
|
|
|
|
|
return $self->EOF; |
395
|
|
|
|
|
|
|
} |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
=head2 get_field |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
$value = $ifh->get_field($field); |
400
|
|
|
|
|
|
|
$value = $ifh->get_field($field, $default); |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
Returns the value of the private field C<$field> from the filehandle. |
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
If that field does not yet exist, and if C<$default> is not specified, |
405
|
|
|
|
|
|
|
then does not modify the object and returns the undefined value. |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
If the field does not yet exist but C<$default> is specified, then |
408
|
|
|
|
|
|
|
creates the field, assigns it the value C<$default>, and then returns |
409
|
|
|
|
|
|
|
that value. |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
=cut |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
sub get_field { |
414
|
0
|
|
|
0
|
1
|
|
my ( $self, $field, $default ) = @_; |
415
|
0
|
|
|
|
|
|
my $href = $self->_get('_'); |
416
|
0
|
0
|
|
|
|
|
if ( @_ >= 3 ) { # $default specified |
417
|
0
|
0
|
|
|
|
|
if ( not $href ) { |
418
|
0
|
|
|
|
|
|
$href = {}; |
419
|
0
|
|
|
|
|
|
$self->_set( '_', $href ); |
420
|
|
|
|
|
|
|
} |
421
|
0
|
|
0
|
|
|
|
$href->{$field} //= $default; |
422
|
|
|
|
|
|
|
} |
423
|
|
|
|
|
|
|
else { # no $default specified |
424
|
0
|
0
|
|
|
|
|
return unless $href; |
425
|
|
|
|
|
|
|
} |
426
|
0
|
|
|
|
|
|
return $href->{$field}; |
427
|
|
|
|
|
|
|
} |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
=head2 getline |
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
$line = $ifh->getline; |
432
|
|
|
|
|
|
|
$line = <$ifh>; |
433
|
|
|
|
|
|
|
$line = readline $ifh; |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
Reads the next line from the B. The input |
436
|
|
|
|
|
|
|
record separator (L<$E|perlvar/"$/">) or end-of-data mark the end |
437
|
|
|
|
|
|
|
of the line. |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
=head2 getlines |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
@lines = $ifh->getlines; |
442
|
|
|
|
|
|
|
@lines = <$ifh>; |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
Reads all remaining lines from the B. The |
445
|
|
|
|
|
|
|
input record separator (L<$E|perlvar/"$/">) or end-of-data mark |
446
|
|
|
|
|
|
|
the end of each line. |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
=cut |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
# for Tie::Handle, read a line |
451
|
|
|
|
|
|
|
sub READLINE { |
452
|
0
|
|
|
0
|
|
|
my ($self) = @_; |
453
|
0
|
0
|
|
|
|
|
if (wantarray) { |
454
|
0
|
|
|
|
|
|
my @lines = (); |
455
|
0
|
|
|
|
|
|
while ( my $line = $self->READLINE ) { |
456
|
0
|
|
|
|
|
|
push @lines, $line; |
457
|
|
|
|
|
|
|
} |
458
|
0
|
|
|
|
|
|
return @lines; |
459
|
|
|
|
|
|
|
} |
460
|
|
|
|
|
|
|
else { |
461
|
0
|
0
|
|
|
|
|
return if $self->EOF; |
462
|
|
|
|
|
|
|
|
463
|
0
|
|
|
|
|
|
my $line = $self->_getline; |
464
|
0
|
|
|
|
|
|
while ( $line !~ m#$/$# ) { |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
# no input record separator at the end; we must have reached the |
467
|
|
|
|
|
|
|
# end of the file -- maybe an included file. |
468
|
0
|
0
|
|
|
|
|
last if $self->EOF; |
469
|
0
|
|
|
|
|
|
$line .= $self->_getline; |
470
|
|
|
|
|
|
|
} |
471
|
0
|
0
|
|
|
|
|
if ( $line =~ $self->_get('include') ) { |
472
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
# the regex matched: include another file |
474
|
1
|
|
0
|
1
|
|
1024
|
my $path = $+{include} // $1; |
|
1
|
|
|
|
|
304
|
|
|
1
|
|
|
|
|
963
|
|
|
0
|
|
|
|
|
|
|
475
|
0
|
0
|
|
|
|
|
croak "No include file path detected" unless $path; |
476
|
0
|
|
|
|
|
|
my $coderef = $self->_get('transform'); |
477
|
0
|
0
|
|
|
|
|
if ($coderef) { |
478
|
0
|
|
|
|
|
|
$path = $coderef->( $path, $self ); |
479
|
|
|
|
|
|
|
} |
480
|
0
|
|
|
|
|
|
$path = file($path); |
481
|
0
|
0
|
|
|
|
|
if ( $path->is_relative ) { |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
# the path is relative; it is relative to the directory of the |
484
|
|
|
|
|
|
|
# including file |
485
|
0
|
|
|
|
|
|
$path = file( file( $self->_get('source') )->parent, $path ); |
486
|
|
|
|
|
|
|
} |
487
|
0
|
0
|
|
|
|
|
if ( CORE::open my $newifh, '<', "$path" ) { |
488
|
0
|
|
|
|
|
|
my $suffix = substr( $line, $+[0] ); # text beyond the regex match |
489
|
0
|
|
|
|
|
|
push @{ $self->_get('suffixes') }, $suffix; # save for later |
|
0
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
|
491
|
0
|
|
|
|
|
|
push @{ $self->_get('ifhs') }, $self->_get('ifh'); # save for later |
|
0
|
|
|
|
|
|
|
492
|
0
|
|
|
|
|
|
push @{ $self->_get('sources') }, |
|
0
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
$self->_get('source'); # save for later |
494
|
|
|
|
|
|
|
|
495
|
0
|
|
|
|
|
|
$self->_set( ifh => $newifh ) # current source is included file |
496
|
|
|
|
|
|
|
->_set( source => $path ); # current source |
497
|
0
|
|
|
|
|
|
$line = substr( $line, 0, $-[0] ) # text before the regex match |
498
|
|
|
|
|
|
|
. $self->READLINE; # append first line from included file |
499
|
|
|
|
|
|
|
} # otherwise we leave the original text |
500
|
|
|
|
|
|
|
} |
501
|
0
|
|
|
|
|
|
return $line; |
502
|
|
|
|
|
|
|
} |
503
|
|
|
|
|
|
|
} |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
=head2 input_line_number |
506
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
$line_number = $ifh->input_line_number; |
508
|
|
|
|
|
|
|
$line_number = $.; |
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
Returns the number of lines read through the |
511
|
|
|
|
|
|
|
B (first example) or through the last used |
512
|
|
|
|
|
|
|
filehandle (second example). |
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
NOTE: The result of this method is not always accurate, because the |
515
|
|
|
|
|
|
|
current module may need to read ahead and buffer some data in order to |
516
|
|
|
|
|
|
|
properly detect and resolve include directives. |
517
|
|
|
|
|
|
|
|
518
|
|
|
|
|
|
|
The results of this method are accurate if (1) all of the data is read |
519
|
|
|
|
|
|
|
by lines, and (2) the include directive always comes at the very end |
520
|
|
|
|
|
|
|
of a line. |
521
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
=head2 open |
523
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
$ih->open({ source => $source, |
525
|
|
|
|
|
|
|
include => $regex, |
526
|
|
|
|
|
|
|
transform => $coderef }); |
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
(Re)opens the B object. See L for |
529
|
|
|
|
|
|
|
details about the arguments. |
530
|
|
|
|
|
|
|
|
531
|
|
|
|
|
|
|
=cut |
532
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
sub open { |
534
|
0
|
|
|
0
|
1
|
|
my ( $self, @args ) = @_; |
535
|
0
|
|
|
|
|
|
my $source; |
536
|
|
|
|
|
|
|
my $regex; |
537
|
0
|
|
|
|
|
|
my $coderef; |
538
|
0
|
0
|
0
|
|
|
|
if ( @args == 1 && ref( $args[0] ) && reftype( $args[0] ) eq 'HASH' ) { |
|
|
|
0
|
|
|
|
|
539
|
0
|
|
|
|
|
|
$source = $args[0]->{source}; |
540
|
0
|
|
|
|
|
|
$regex = $args[0]->{include}; |
541
|
0
|
|
|
|
|
|
$coderef = $args[0]->{transform}; |
542
|
|
|
|
|
|
|
} |
543
|
|
|
|
|
|
|
else { |
544
|
0
|
|
|
|
|
|
croak "Expected a single argument, a reference to a hash."; |
545
|
|
|
|
|
|
|
} |
546
|
0
|
0
|
0
|
|
|
|
croak "Source must be a scalar or filehandle" |
547
|
|
|
|
|
|
|
if ref($source) ne '' |
548
|
|
|
|
|
|
|
and reftype($source) ne 'GLOB'; |
549
|
0
|
0
|
0
|
|
|
|
croak "Include specification must be a regular expression" |
550
|
|
|
|
|
|
|
if not($regex) |
551
|
|
|
|
|
|
|
or reftype($regex) ne 'REGEXP'; |
552
|
0
|
0
|
0
|
|
|
|
croak "Transform, if set, must be a code reference" |
553
|
|
|
|
|
|
|
if $coderef and reftype($coderef) ne 'CODE'; |
554
|
0
|
|
|
|
|
|
$self->_set( source => $source )->_set( main_source => $source ) |
555
|
|
|
|
|
|
|
->_set( include => $regex )->_set( transform => $coderef ); |
556
|
0
|
|
|
|
|
|
return $self; |
557
|
|
|
|
|
|
|
} |
558
|
|
|
|
|
|
|
|
559
|
|
|
|
|
|
|
# If we're reading from an included file, then act as if that included |
560
|
|
|
|
|
|
|
# file is exhausted: close it, revert to the including file, and |
561
|
|
|
|
|
|
|
# return 1. Otherwise return 0. |
562
|
|
|
|
|
|
|
sub _end_include { |
563
|
0
|
|
|
0
|
|
|
my ($self) = @_; |
564
|
0
|
|
|
|
|
|
my $ifh = $self->_get('ifh'); |
565
|
0
|
0
|
|
|
|
|
if ($ifh) { # already reading |
566
|
0
|
|
|
|
|
|
my $ifhs = $self->_get('ifhs'); |
567
|
0
|
0
|
|
|
|
|
if (@$ifhs) { # inside an include file |
568
|
0
|
|
|
|
|
|
close $ifh; # close the included file |
569
|
0
|
|
|
|
|
|
$self->_set( ifh => pop @{$ifhs} ) # revert to including file |
570
|
|
|
|
|
|
|
->_set( |
571
|
0
|
|
|
|
|
|
buffer => $self->_get('buffer') . pop @{ $self->_get('suffixes') } ) |
572
|
0
|
|
|
|
|
|
->_set( source => pop @{ $self->_get('sources') } ); |
|
0
|
|
|
|
|
|
|
573
|
0
|
|
|
|
|
|
return 1; |
574
|
|
|
|
|
|
|
} # otherwise we're in the main file |
575
|
|
|
|
|
|
|
} # otherwise it's a no-op |
576
|
0
|
|
|
|
|
|
return 0; |
577
|
|
|
|
|
|
|
} |
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
# returns the next line of input, taking into account any buffered |
580
|
|
|
|
|
|
|
# input. |
581
|
|
|
|
|
|
|
sub _getline { |
582
|
0
|
|
|
0
|
|
|
my ($self) = @_; |
583
|
0
|
|
|
|
|
|
my $line = ''; |
584
|
0
|
|
|
|
|
|
my $buffer = $self->_get('buffer'); |
585
|
0
|
0
|
|
|
|
|
if ($buffer) { |
586
|
0
|
|
|
|
|
|
$line = $buffer; |
587
|
0
|
|
|
|
|
|
$self->_set( buffer => '' ); |
588
|
0
|
0
|
|
|
|
|
if ( $line =~ m#$/$# ) { |
589
|
0
|
|
|
|
|
|
return $line; |
590
|
|
|
|
|
|
|
} |
591
|
|
|
|
|
|
|
} |
592
|
0
|
|
|
|
|
|
my $ifh = $self->_get('ifh'); |
593
|
0
|
0
|
|
|
|
|
if ( not CORE::eof($ifh) ) { |
594
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
# If I combine the next two statements into one, then <$ifh> is |
596
|
|
|
|
|
|
|
# evaluated in list context (i.e., read all remaining lines) and |
597
|
|
|
|
|
|
|
# then converted to scalar context (i.e., yield the number of |
598
|
|
|
|
|
|
|
# lines read). This is not what we want, so keep them separate. |
599
|
0
|
|
|
|
|
|
my $nextline = <$ifh>; |
600
|
0
|
|
|
|
|
|
$line .= $nextline; |
601
|
|
|
|
|
|
|
} |
602
|
0
|
|
|
|
|
|
return $line; |
603
|
|
|
|
|
|
|
} |
604
|
|
|
|
|
|
|
|
605
|
|
|
|
|
|
|
=head2 read |
606
|
|
|
|
|
|
|
|
607
|
|
|
|
|
|
|
$ifh->read($buffer, $length, $offset); |
608
|
|
|
|
|
|
|
read $ifh, $buffer, $length, $offset; |
609
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
Read up to C<$length> characters from the B |
611
|
|
|
|
|
|
|
into the C<$buffer> at offset C<$offset>, similar to the |
612
|
|
|
|
|
|
|
L function. Returns the number of |
613
|
|
|
|
|
|
|
characters read, or 0 when there are no more characters. |
614
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
If L is active, then the reading stops after the |
616
|
|
|
|
|
|
|
first encountered input record separator (L<$E|perlvar/"$/">), |
617
|
|
|
|
|
|
|
even if the requested number of characters has not been reached yet. |
618
|
|
|
|
|
|
|
|
619
|
|
|
|
|
|
|
=cut |
620
|
|
|
|
|
|
|
|
621
|
|
|
|
|
|
|
# for Tie::Handle, read bytes |
622
|
|
|
|
|
|
|
sub READ { |
623
|
0
|
|
|
0
|
|
|
my ( $self, undef, $length, $offset ) = @_; |
624
|
0
|
|
|
|
|
|
my $bufref = \$_[1]; |
625
|
0
|
|
0
|
|
|
|
$offset //= 0; |
626
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
# Adjust buffer for appending at $offset: Any previous contents |
628
|
|
|
|
|
|
|
# beyond that offset are lost. If the buffer is not that long, then |
629
|
|
|
|
|
|
|
# pad with \0 until it is long enough. (This is what CORE::read |
630
|
|
|
|
|
|
|
# does, too.) |
631
|
|
|
|
|
|
|
|
632
|
0
|
|
|
|
|
|
my $l = length($$bufref); |
633
|
0
|
0
|
|
|
|
|
if ( $offset < 0 ) { |
634
|
0
|
|
|
|
|
|
$offset = $l - $offset; |
635
|
0
|
0
|
|
|
|
|
if ( $offset < 0 ) { |
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
# TODO: what does CORE::read do in this case? |
638
|
0
|
|
|
|
|
|
$offset = 0; |
639
|
|
|
|
|
|
|
} |
640
|
|
|
|
|
|
|
} |
641
|
0
|
0
|
|
|
|
|
if ( $offset < $l ) { |
|
|
0
|
|
|
|
|
|
642
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
# chop off everything beyond $offset |
644
|
0
|
|
|
|
|
|
substr $$bufref, $offset, $l - $offset, ''; |
645
|
|
|
|
|
|
|
} |
646
|
|
|
|
|
|
|
elsif ( $offset > $l ) { |
647
|
|
|
|
|
|
|
|
648
|
|
|
|
|
|
|
# pad \0 until the offset |
649
|
0
|
|
|
|
|
|
$$bufref .= '\x0' x ( $offset - $l ); |
650
|
|
|
|
|
|
|
} |
651
|
|
|
|
|
|
|
|
652
|
0
|
0
|
|
|
|
|
if ( $self->EOF ) { |
653
|
0
|
|
|
|
|
|
return 0; |
654
|
|
|
|
|
|
|
} |
655
|
|
|
|
|
|
|
|
656
|
|
|
|
|
|
|
# we obtain data using READLINE, because only then can we reliably |
657
|
|
|
|
|
|
|
# detect include directives. See main POD for an explanation. |
658
|
|
|
|
|
|
|
|
659
|
|
|
|
|
|
|
# calling READLINE updates the line number, which READ isn't |
660
|
|
|
|
|
|
|
# supposed to do. Remember the current value, so we can restore it |
661
|
|
|
|
|
|
|
# later. |
662
|
0
|
|
|
|
|
|
my $old_dot = $.; |
663
|
|
|
|
|
|
|
|
664
|
0
|
|
|
|
|
|
my $line; |
665
|
|
|
|
|
|
|
my $n; |
666
|
0
|
0
|
|
|
|
|
if ( $self->_get('read_by_line') ) { |
667
|
|
|
|
|
|
|
|
668
|
|
|
|
|
|
|
# return at most a single line |
669
|
0
|
|
|
|
|
|
$line = $self->READLINE; |
670
|
0
|
|
|
|
|
|
$n = length($line); |
671
|
|
|
|
|
|
|
} |
672
|
|
|
|
|
|
|
else { |
673
|
|
|
|
|
|
|
# return data until the requested number of characters is reached |
674
|
|
|
|
|
|
|
# or the data runs out. |
675
|
0
|
|
|
|
|
|
$line = ''; |
676
|
0
|
|
|
|
|
|
$n = 0; |
677
|
0
|
|
0
|
|
|
|
while ( $n < $length && not $self->EOF ) { |
678
|
0
|
|
|
|
|
|
$line .= $self->READLINE; |
679
|
0
|
|
|
|
|
|
$n = length($line); |
680
|
|
|
|
|
|
|
} |
681
|
|
|
|
|
|
|
} |
682
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
# restore old line number |
684
|
0
|
|
|
|
|
|
$. = $old_dot; |
685
|
|
|
|
|
|
|
|
686
|
0
|
0
|
|
|
|
|
if ( $n > $length ) { |
687
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
# we read more than was requested. Remember the excess for next |
689
|
|
|
|
|
|
|
# time (managed by READLINE). We divide $line into a first part |
690
|
|
|
|
|
|
|
# with the desired $length, and a second part beyond that length, |
691
|
|
|
|
|
|
|
# which we prepend to the buffer. |
692
|
0
|
|
|
|
|
|
$self->_set( |
693
|
|
|
|
|
|
|
buffer => substr( $line, $length, $n, '' ) . $self->_get('buffer') ); |
694
|
0
|
|
|
|
|
|
$n = $length; |
695
|
|
|
|
|
|
|
} |
696
|
0
|
|
|
|
|
|
$$bufref .= $line; |
697
|
0
|
|
|
|
|
|
return $n; |
698
|
|
|
|
|
|
|
} |
699
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
=head2 remove_field |
701
|
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
$cfh->remove_field($field); |
703
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
Removes the filehandle's private field with the specified name, if it |
705
|
|
|
|
|
|
|
exists. Returns the filehandle. |
706
|
|
|
|
|
|
|
|
707
|
|
|
|
|
|
|
=cut |
708
|
|
|
|
|
|
|
|
709
|
|
|
|
|
|
|
sub remove_field { |
710
|
0
|
|
|
0
|
1
|
|
my ( $self, $field ) = @_; |
711
|
0
|
|
|
|
|
|
my $href = $self->_get('_'); |
712
|
0
|
0
|
|
|
|
|
if ($href) { |
713
|
0
|
|
|
|
|
|
delete $href->{$field}; |
714
|
|
|
|
|
|
|
} |
715
|
0
|
|
|
|
|
|
return $self; |
716
|
|
|
|
|
|
|
} |
717
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
=head2 seek |
719
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
seek $ifh, $pos, $whence; |
721
|
|
|
|
|
|
|
$ifh->seek($pos, $whence); |
722
|
|
|
|
|
|
|
|
723
|
|
|
|
|
|
|
Sets the B filehandle's position, similar to |
724
|
|
|
|
|
|
|
the L function -- but at present the support |
725
|
|
|
|
|
|
|
is very limited. |
726
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
C<$whence> indicates relative to what the target position C<$pos> is |
728
|
|
|
|
|
|
|
specified. This can be 0 for the beginning of the data, 1 for the |
729
|
|
|
|
|
|
|
current position, or 2 for the end of the data. |
730
|
|
|
|
|
|
|
|
731
|
|
|
|
|
|
|
C<$pos> says how many bytes beyond the position indicated by |
732
|
|
|
|
|
|
|
C<$whence> to set the filehandle to. At present, C<$pos> must be |
733
|
|
|
|
|
|
|
equal to 0, otherwise the method croaks. So, the position can only be |
734
|
|
|
|
|
|
|
set to the very beginning, the very end, or the current position. |
735
|
|
|
|
|
|
|
Supporting more requires a lot more bookkeeping. |
736
|
|
|
|
|
|
|
|
737
|
|
|
|
|
|
|
Returns 1 on success, false otherwise. |
738
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
=cut |
740
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
sub seek { |
742
|
0
|
|
|
0
|
1
|
|
return SEEK(@_); |
743
|
|
|
|
|
|
|
} |
744
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
# for Tie::Handle, seek. We support only seeking to the beginning, |
746
|
|
|
|
|
|
|
# end, or current position. For anything else we'd need to do a lot |
747
|
|
|
|
|
|
|
# of additional bookkeeping. |
748
|
|
|
|
|
|
|
sub SEEK { |
749
|
0
|
|
|
0
|
|
|
my ( $self, $position, $whence ) = @_; |
750
|
0
|
0
|
|
|
|
|
if ( $position == 0 ) { |
751
|
0
|
0
|
|
|
|
|
if ( $whence != 1 ) { |
752
|
|
|
|
|
|
|
|
753
|
|
|
|
|
|
|
# seek to the very beginning or end |
754
|
|
|
|
|
|
|
|
755
|
|
|
|
|
|
|
# close any included files |
756
|
0
|
|
|
|
|
|
1 while $self->_end_include; |
757
|
0
|
|
|
|
|
|
return CORE::seek( $self->_get('ifh'), $position, $whence ); |
758
|
|
|
|
|
|
|
} # otherwise we seek to where we already are: a no-op |
759
|
|
|
|
|
|
|
} |
760
|
|
|
|
|
|
|
else { |
761
|
0
|
|
|
|
|
|
croak |
762
|
|
|
|
|
|
|
"Cannot seek to anywhere except here or the beginning or the end via a " |
763
|
|
|
|
|
|
|
. blessed($self); |
764
|
|
|
|
|
|
|
} |
765
|
0
|
|
|
|
|
|
return 1; |
766
|
|
|
|
|
|
|
} |
767
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
=head2 set_field |
769
|
|
|
|
|
|
|
|
770
|
|
|
|
|
|
|
$ifh->set_field($field, $value); |
771
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
Sets the filehandle's private field with key C<$field> to the |
773
|
|
|
|
|
|
|
specified C<$value>. Returns the filehandle. |
774
|
|
|
|
|
|
|
|
775
|
|
|
|
|
|
|
=cut |
776
|
|
|
|
|
|
|
|
777
|
|
|
|
|
|
|
sub set_field { |
778
|
0
|
|
|
0
|
1
|
|
my ( $self, $field, $value ) = @_; |
779
|
0
|
|
|
|
|
|
my $href = $self->_get('_'); |
780
|
0
|
0
|
|
|
|
|
if ( not $href ) { |
781
|
0
|
|
|
|
|
|
$self->_set( '_', $href = {} ); |
782
|
|
|
|
|
|
|
} |
783
|
0
|
|
|
|
|
|
$href->{$field} = $value; |
784
|
0
|
|
|
|
|
|
return $self; |
785
|
|
|
|
|
|
|
} |
786
|
|
|
|
|
|
|
|
787
|
|
|
|
|
|
|
=head2 set_read_by_line |
788
|
|
|
|
|
|
|
|
789
|
|
|
|
|
|
|
$ifh->set_read_by_line($value); |
790
|
|
|
|
|
|
|
$ifh->set_read_by_line; |
791
|
|
|
|
|
|
|
|
792
|
|
|
|
|
|
|
Configures whether L can return more than a single line's worth |
793
|
|
|
|
|
|
|
of data per call. |
794
|
|
|
|
|
|
|
|
795
|
|
|
|
|
|
|
By default, a single L call reads and returns data until the |
796
|
|
|
|
|
|
|
requested number of characters has been read or until it runs out of |
797
|
|
|
|
|
|
|
data, whichever comes first. If C is called without |
798
|
|
|
|
|
|
|
an argument or with an argument that is a true value (e.g., 1), then |
799
|
|
|
|
|
|
|
subsequent calls of L return at most the next line, as defined |
800
|
|
|
|
|
|
|
by the input record separator L<$E|perlvar/"S/"> -- or less, if |
801
|
|
|
|
|
|
|
the requested number of characters has been reached. If |
802
|
|
|
|
|
|
|
C is called with an argument that is a false value |
803
|
|
|
|
|
|
|
(e.g., 0), then L reverts to its default behavior. |
804
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
=cut |
806
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
sub set_read_by_line { |
808
|
0
|
|
|
0
|
1
|
|
my ( $self, $value ) = @_; |
809
|
0
|
|
0
|
|
|
|
$value //= 1; |
810
|
0
|
|
|
|
|
|
$self->_set( 'read_by_line', $value ); |
811
|
|
|
|
|
|
|
} |
812
|
|
|
|
|
|
|
|
813
|
|
|
|
|
|
|
=head2 set_transform |
814
|
|
|
|
|
|
|
|
815
|
|
|
|
|
|
|
$ifh->set_transform($coderef); |
816
|
|
|
|
|
|
|
|
817
|
|
|
|
|
|
|
Sets the transformation code reference, with the same purpose as the |
818
|
|
|
|
|
|
|
C parameter of L. Returns the object. |
819
|
|
|
|
|
|
|
|
820
|
|
|
|
|
|
|
=cut |
821
|
|
|
|
|
|
|
|
822
|
|
|
|
|
|
|
sub set_transform { |
823
|
0
|
|
|
0
|
1
|
|
my ( $self, $coderef ) = @_; |
824
|
0
|
0
|
|
|
|
|
croak "Transform must be a code reference" |
825
|
|
|
|
|
|
|
unless ref($coderef) eq 'CODE'; |
826
|
0
|
|
|
|
|
|
$self->_set( transform => $coderef ); |
827
|
0
|
|
|
|
|
|
return $self; |
828
|
|
|
|
|
|
|
} |
829
|
|
|
|
|
|
|
|
830
|
|
|
|
|
|
|
=head1 AUTHOR |
831
|
|
|
|
|
|
|
|
832
|
|
|
|
|
|
|
Louis Strous, C<< >> |
833
|
|
|
|
|
|
|
|
834
|
|
|
|
|
|
|
=head1 BUGS |
835
|
|
|
|
|
|
|
|
836
|
|
|
|
|
|
|
=head2 KNOWN BUGS |
837
|
|
|
|
|
|
|
|
838
|
|
|
|
|
|
|
Resolving these bugs requires much more bookkeeping. |
839
|
|
|
|
|
|
|
|
840
|
|
|
|
|
|
|
=over |
841
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
=item |
843
|
|
|
|
|
|
|
|
844
|
|
|
|
|
|
|
The result of L (and L<$.|perlvar/$.>) may not be |
845
|
|
|
|
|
|
|
accurate. |
846
|
|
|
|
|
|
|
|
847
|
|
|
|
|
|
|
=item |
848
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
The result of L may not be accurate. |
850
|
|
|
|
|
|
|
|
851
|
|
|
|
|
|
|
=item |
852
|
|
|
|
|
|
|
|
853
|
|
|
|
|
|
|
L can only be used to go to the very beginning, the current |
854
|
|
|
|
|
|
|
position, or the very end of the stream. |
855
|
|
|
|
|
|
|
|
856
|
|
|
|
|
|
|
=item |
857
|
|
|
|
|
|
|
|
858
|
|
|
|
|
|
|
L cannot be used on an B. |
859
|
|
|
|
|
|
|
|
860
|
|
|
|
|
|
|
=back |
861
|
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
=head2 REPORT BUGS |
863
|
|
|
|
|
|
|
|
864
|
|
|
|
|
|
|
Please report any bugs or feature requests to |
865
|
|
|
|
|
|
|
C, or through the web |
866
|
|
|
|
|
|
|
interface at |
867
|
|
|
|
|
|
|
L. |
868
|
|
|
|
|
|
|
I will be notified, and then you'll automatically be notified of |
869
|
|
|
|
|
|
|
progress on your bug as I make changes. |
870
|
|
|
|
|
|
|
|
871
|
|
|
|
|
|
|
=head1 SUPPORT |
872
|
|
|
|
|
|
|
|
873
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
874
|
|
|
|
|
|
|
|
875
|
|
|
|
|
|
|
perldoc IO::ReadHandle::Include |
876
|
|
|
|
|
|
|
|
877
|
|
|
|
|
|
|
|
878
|
|
|
|
|
|
|
You can also look for information at: |
879
|
|
|
|
|
|
|
|
880
|
|
|
|
|
|
|
=over 4 |
881
|
|
|
|
|
|
|
|
882
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker (report bugs here) |
883
|
|
|
|
|
|
|
|
884
|
|
|
|
|
|
|
L |
885
|
|
|
|
|
|
|
|
886
|
|
|
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation |
887
|
|
|
|
|
|
|
|
888
|
|
|
|
|
|
|
L |
889
|
|
|
|
|
|
|
|
890
|
|
|
|
|
|
|
=item * CPAN Ratings |
891
|
|
|
|
|
|
|
|
892
|
|
|
|
|
|
|
L |
893
|
|
|
|
|
|
|
|
894
|
|
|
|
|
|
|
=item * Search CPAN |
895
|
|
|
|
|
|
|
|
896
|
|
|
|
|
|
|
L |
897
|
|
|
|
|
|
|
|
898
|
|
|
|
|
|
|
=back |
899
|
|
|
|
|
|
|
|
900
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
901
|
|
|
|
|
|
|
|
902
|
|
|
|
|
|
|
Copyright 2018 Louis Strous. |
903
|
|
|
|
|
|
|
|
904
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
905
|
|
|
|
|
|
|
under the terms of the the Artistic License (2.0). You may obtain a |
906
|
|
|
|
|
|
|
copy of the full license at: |
907
|
|
|
|
|
|
|
|
908
|
|
|
|
|
|
|
L |
909
|
|
|
|
|
|
|
|
910
|
|
|
|
|
|
|
Any use, modification, and distribution of the Standard or Modified |
911
|
|
|
|
|
|
|
Versions is governed by this Artistic License. By using, modifying or |
912
|
|
|
|
|
|
|
distributing the Package, you accept this license. Do not use, modify, |
913
|
|
|
|
|
|
|
or distribute the Package, if you do not accept this license. |
914
|
|
|
|
|
|
|
|
915
|
|
|
|
|
|
|
If your Modified Version has been derived from a Modified Version made |
916
|
|
|
|
|
|
|
by someone other than you, you are nevertheless required to ensure that |
917
|
|
|
|
|
|
|
your Modified Version complies with the requirements of this license. |
918
|
|
|
|
|
|
|
|
919
|
|
|
|
|
|
|
This license does not grant you the right to use any trademark, service |
920
|
|
|
|
|
|
|
mark, tradename, or logo of the Copyright Holder. |
921
|
|
|
|
|
|
|
|
922
|
|
|
|
|
|
|
This license includes the non-exclusive, worldwide, free-of-charge |
923
|
|
|
|
|
|
|
patent license to make, have made, use, offer to sell, sell, import and |
924
|
|
|
|
|
|
|
otherwise transfer the Package with respect to any patent claims |
925
|
|
|
|
|
|
|
licensable by the Copyright Holder that are necessarily infringed by the |
926
|
|
|
|
|
|
|
Package. If you institute patent litigation (including a cross-claim or |
927
|
|
|
|
|
|
|
counterclaim) against any party alleging that the Package constitutes |
928
|
|
|
|
|
|
|
direct or contributory patent infringement, then this Artistic License |
929
|
|
|
|
|
|
|
to you shall terminate on the date that such litigation is filed. |
930
|
|
|
|
|
|
|
|
931
|
|
|
|
|
|
|
Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER |
932
|
|
|
|
|
|
|
AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. |
933
|
|
|
|
|
|
|
THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR |
934
|
|
|
|
|
|
|
PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY |
935
|
|
|
|
|
|
|
YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR |
936
|
|
|
|
|
|
|
CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR |
937
|
|
|
|
|
|
|
CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, |
938
|
|
|
|
|
|
|
EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |
939
|
|
|
|
|
|
|
|
940
|
|
|
|
|
|
|
=head1 SEE ALSO |
941
|
|
|
|
|
|
|
|
942
|
|
|
|
|
|
|
L. |
943
|
|
|
|
|
|
|
|
944
|
|
|
|
|
|
|
=cut |
945
|
|
|
|
|
|
|
|
946
|
|
|
|
|
|
|
1; # End of IO::ReadHandle::Include |