line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package IO::Handle::Iterator; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
29457
|
use strict; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
74
|
|
4
|
2
|
|
|
2
|
|
11
|
use warnings; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
66
|
|
5
|
|
|
|
|
|
|
|
6
|
2
|
|
|
2
|
|
12
|
use Carp (); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
44
|
|
7
|
|
|
|
|
|
|
|
8
|
2
|
|
|
2
|
|
1725
|
use parent qw(IO::Handle::Prototype); |
|
2
|
|
|
|
|
615
|
|
|
2
|
|
|
|
|
10
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
# error, clearerr, new_from_fd, fdopen |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
sub new { |
13
|
8
|
|
|
8
|
0
|
47
|
my ( $class, $cb ) = @_; |
14
|
|
|
|
|
|
|
|
15
|
8
|
|
|
|
|
51
|
bless { |
16
|
|
|
|
|
|
|
cb => $cb, |
17
|
|
|
|
|
|
|
}, $class; |
18
|
|
|
|
|
|
|
} |
19
|
|
|
|
|
|
|
|
20
|
24
|
|
|
24
|
0
|
57
|
sub getline { shift->_cb } |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
sub _cb { |
23
|
31
|
|
|
31
|
|
40
|
my $self = shift; |
24
|
|
|
|
|
|
|
|
25
|
31
|
50
|
|
|
|
212
|
if ( my $cb = $self->{cb} ) { |
26
|
31
|
100
|
|
|
|
83
|
if ( defined(my $next = $cb->()) ) { |
27
|
23
|
|
|
|
|
97
|
return $next; |
28
|
|
|
|
|
|
|
} else { |
29
|
8
|
|
|
|
|
36
|
$self->close; |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
} |
32
|
|
|
|
|
|
|
|
33
|
8
|
|
|
|
|
50
|
return; |
34
|
|
|
|
|
|
|
} |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
sub _rebless_and { |
37
|
2
|
|
|
2
|
|
4
|
my $self = shift; |
38
|
2
|
|
|
|
|
3
|
my $method = shift; |
39
|
|
|
|
|
|
|
|
40
|
2
|
|
|
|
|
8
|
bless $self, "IO::Handle::Iterator::Buffered"; |
41
|
|
|
|
|
|
|
|
42
|
2
|
|
|
|
|
10
|
$self->$method(@_); |
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
|
45
|
2
|
|
|
2
|
0
|
10
|
sub read { shift->_rebless_and( read => @_ ) } |
46
|
0
|
|
|
0
|
0
|
0
|
sub sysread { shift->_rebless_and( sysread => @_ ) } |
47
|
0
|
|
|
0
|
0
|
0
|
sub getc { shift->_rebless_and( getc => @_ ) } |
48
|
0
|
|
|
0
|
0
|
0
|
sub ungetc { shift->_rebless_and( ungetc => @_ ) } |
49
|
|
|
|
|
|
|
|
50
|
0
|
|
|
0
|
0
|
0
|
sub open { Carp::croak("Can't open an iterator") } |
51
|
0
|
|
|
0
|
0
|
0
|
sub print { Carp::croak("Can't print to iterator") } |
52
|
0
|
|
|
0
|
0
|
0
|
sub printflush { Carp::croak("Can't print to iterator") } |
53
|
0
|
|
|
0
|
0
|
0
|
sub printf { Carp::croak("Can't print to iterator") } |
54
|
0
|
|
|
0
|
0
|
0
|
sub say { Carp::croak("Can't print to iterator") } |
55
|
0
|
|
|
0
|
0
|
0
|
sub write { Carp::croak("Can't write to iterator") } |
56
|
0
|
|
|
0
|
0
|
0
|
sub syswrite { Carp::croak("Can't write to iterator") } |
57
|
0
|
|
|
0
|
0
|
0
|
sub format_write { Carp::croak("Can't write to iterator") } |
58
|
0
|
|
|
0
|
0
|
0
|
sub ioctl { Carp::croak("Can't ioctl on iterator") } |
59
|
0
|
|
|
0
|
0
|
0
|
sub fcntl { Carp::croak("Can't fcntl on iterator") } |
60
|
0
|
|
|
0
|
0
|
0
|
sub truncate { Carp::croak("Can't truncate iterator") } |
61
|
0
|
|
|
0
|
0
|
0
|
sub sync { Carp::croak("Can't sync an iterator") } |
62
|
0
|
|
|
0
|
0
|
0
|
sub flush { Carp::croak("Can't flush an iterator") } |
63
|
|
|
|
|
|
|
|
64
|
0
|
|
|
0
|
0
|
0
|
sub autoflush { 1 } |
65
|
|
|
|
|
|
|
|
66
|
0
|
|
|
0
|
0
|
0
|
sub opened { 1 } |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
sub blocking { |
69
|
0
|
|
|
0
|
0
|
0
|
my ( $self, @args ) = @_; |
70
|
|
|
|
|
|
|
|
71
|
0
|
0
|
|
|
|
0
|
Carp::croak("Can't set blocking mode on iterator") if @args; |
72
|
|
|
|
|
|
|
|
73
|
0
|
|
|
|
|
0
|
return 1; |
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
|
76
|
0
|
|
|
0
|
0
|
0
|
sub stat { return undef } |
77
|
0
|
|
|
0
|
0
|
0
|
sub fileno { return undef } |
78
|
|
|
|
|
|
|
|
79
|
8
|
|
|
8
|
0
|
25
|
sub close { delete $_[0]{cb} } |
80
|
15
|
|
|
15
|
0
|
3865
|
sub eof { not exists $_[0]{cb} } |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
sub getlines { |
83
|
4
|
|
|
4
|
0
|
6
|
my $self = shift; |
84
|
|
|
|
|
|
|
|
85
|
4
|
|
|
|
|
6
|
my @accum; |
86
|
|
|
|
|
|
|
|
87
|
4
|
|
|
|
|
10
|
while ( defined(my $next = $self->getline) ) { |
88
|
8
|
|
|
|
|
23
|
push @accum, $next; |
89
|
|
|
|
|
|
|
} |
90
|
|
|
|
|
|
|
|
91
|
4
|
|
|
|
|
32
|
return @accum; |
92
|
|
|
|
|
|
|
} |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
package IO::Handle::Iterator::Buffered; # FIXME IO::Handle::BufferMixin? |
95
|
2
|
|
|
2
|
|
1818
|
use parent qw(IO::Handle::Iterator); |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
12
|
|
96
|
|
|
|
|
|
|
|
97
|
2
|
|
|
2
|
|
139
|
no warnings 'uninitialized'; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
1119
|
|
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
sub eof { |
100
|
13
|
|
|
13
|
|
20
|
my $self = shift; |
101
|
|
|
|
|
|
|
|
102
|
13
|
100
|
|
|
|
228
|
length($self->{buf}) == 0 |
103
|
|
|
|
|
|
|
and |
104
|
|
|
|
|
|
|
$self->SUPER::eof; |
105
|
|
|
|
|
|
|
} |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
sub getc { |
108
|
2
|
|
|
2
|
|
6
|
shift->read(my $c, 1); |
109
|
2
|
|
|
|
|
10
|
return $c; |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
sub ungetc { |
113
|
1
|
|
|
1
|
|
3
|
my ( $self, $ord ) = @_; |
114
|
1
|
|
|
|
|
5
|
substr($self->{buf}, 0, 0, chr($ord)); # yuck |
115
|
1
|
|
|
|
|
2
|
return; |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
|
118
|
0
|
|
|
0
|
|
0
|
sub sysread { shift->read(@_) } |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
sub read { |
121
|
6
|
|
|
6
|
|
15
|
my ( $self, undef, $length, $offset ) = @_; |
122
|
|
|
|
|
|
|
|
123
|
6
|
50
|
|
|
|
14
|
return 0 if $self->eof; |
124
|
|
|
|
|
|
|
|
125
|
6
|
100
|
66
|
|
|
22
|
if ( $offset and length($_[1]) < $offset ) { |
126
|
1
|
|
|
|
|
4
|
$_[1] .= "\0" x ( $offset - length($_[1]) ); |
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
|
129
|
6
|
|
|
|
|
20
|
while (length($self->{buf}) < $length) { |
130
|
7
|
100
|
|
|
|
18
|
if ( defined(my $next = $self->_cb) ) { |
131
|
6
|
|
|
|
|
25
|
$self->{buf} .= $next; |
132
|
|
|
|
|
|
|
} else { |
133
|
|
|
|
|
|
|
# data ended but still under $length, return all that remains and |
134
|
|
|
|
|
|
|
# empty the buffer |
135
|
1
|
|
|
|
|
3
|
my $ret = length($self->{buf}); |
136
|
|
|
|
|
|
|
|
137
|
1
|
50
|
|
|
|
5
|
if ( $offset ) { |
138
|
1
|
|
|
|
|
4
|
substr($_[1], $offset) = delete $self->{buf}; |
139
|
|
|
|
|
|
|
} else { |
140
|
0
|
|
|
|
|
0
|
$_[1] = delete $self->{buf}; |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
|
143
|
1
|
|
|
|
|
7
|
return $ret; |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
|
147
|
5
|
|
|
|
|
6
|
my $read; |
148
|
5
|
50
|
|
|
|
12
|
if ( $length > length($self->{buf}) ) { |
149
|
0
|
|
|
|
|
0
|
$read = delete $self->{buf}; |
150
|
|
|
|
|
|
|
} else { |
151
|
5
|
|
|
|
|
53
|
$read = substr($self->{buf}, 0, $length, ''); |
152
|
|
|
|
|
|
|
} |
153
|
|
|
|
|
|
|
|
154
|
5
|
50
|
|
|
|
12
|
if ( $offset ) { |
155
|
0
|
|
|
|
|
0
|
substr($_[1], $offset) = $read; |
156
|
|
|
|
|
|
|
} else { |
157
|
5
|
|
|
|
|
11
|
$_[1] = $read; |
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
|
160
|
5
|
|
|
|
|
18
|
return length($read); |
161
|
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
sub getline { |
164
|
1
|
|
|
1
|
|
3
|
my $self = shift; |
165
|
|
|
|
|
|
|
|
166
|
1
|
|
|
|
|
5
|
my $line = delete $self->{buf}; |
167
|
|
|
|
|
|
|
|
168
|
1
|
|
|
|
|
4
|
bless $self, 'IO::Handle::Iterator'; |
169
|
|
|
|
|
|
|
|
170
|
1
|
|
|
|
|
6
|
return $line; |
171
|
|
|
|
|
|
|
} |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
__PACKAGE__ |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
# ex: set sw=4 et: |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
__END__ |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
=head1 NAME |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
IO::Handle::Iterator - Iterator based read handle |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
=head1 SYNOPSIS |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
IO::Handle::Iterator->new(sub { |
186
|
|
|
|
|
|
|
return $next_line; # or undef on eof |
187
|
|
|
|
|
|
|
}); |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
=head1 DESCRIPTION |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
This class lets you define a read handle with a few fallback methods (like |
192
|
|
|
|
|
|
|
C<read>) using a single callback that behaves like C<getline>. |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
This is similar but much simpler than: |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
IO::Handle::Prototype::Fallback->new( |
197
|
|
|
|
|
|
|
__read => sub { ... }, |
198
|
|
|
|
|
|
|
); |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
The reason being that the L<IO::Handle::Prototype::Fallback> implementation |
201
|
|
|
|
|
|
|
will try its very best to behave correctly (i.e. respect the value of C<$/>), |
202
|
|
|
|
|
|
|
whereas this implementation assumes it's fine to return things that aren't |
203
|
|
|
|
|
|
|
exactly lines from C<getline>, so the values are just passed through. |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
=head1 READ BUFFERING |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
When a method that requires buffering is invoked the handle is reblessed to a |
208
|
|
|
|
|
|
|
subclass which handles buffering. |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
Calling C<getline> again on this object will return the value of the buffer and |
211
|
|
|
|
|
|
|
return to the normal iterator class. |
212
|
|
|
|
|
|
|
|