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