| 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 |