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