package Peek;
use Carp;
use Tie::Handle;
use strict;
our @ISA = 'Tie::StdHandle';
our $SILENT = 0;
my %buffer;
=head1 NAME
Peek - interface to allow "peeking" at filehandles
=head1 SYNOPSIS
use Peek;
use strict;
use warnings;
open FOO, "< somefile" or die "can't open somefile: $!";
while (<FOO>) {
chomp;
print "Current line '$_'\n";
chomp(my $next = peek FOO);
print "Next line will be '$next'\n";
}
close FOO;
=head1 DESCRIPTION
This installs a method into the C<IO::Handle> class named C<peek()>.
+If you
call C<peek()> on a filehandle, the filehandle becomes a C<Peek> objec
+t, and
then you can peek at the next lines in the filehandle.
You will be warned about the installation of the filehandle as a C<Pee
+k>
object the first time you call C<peek()> on it. To silence this, set
+the
C<$Peek::SILENT> variable to a true value.
=head1 BUGS
I have to call C<tell()> on the filehandle before I turn it into a C<P
+eek>
object, or else the code breaks (in certain conditions).
=head1 AUTHOR
Jeff C<japhy> Pinyan, F<japhy@pobox.com>
Inspired by F<http://www.perlmonks.org/index.pl?node_id=181068>.
=cut
sub TIEHANDLE {
my ($class, $io) = @_;
bless $io, $class;
}
sub READLINE {
my ($io) = @_;
my $buf = $buffer{$io};
if (@$buf) {
if (wantarray) { return splice(@$buf, 0), <$io> }
else { return shift @$buf }
}
else { return <$io> }
}
sub IO::Handle::peek {
my ($fh) = @_;
my $name = *$fh{NAME};
my $obj = tied *$fh;
unless ($obj and UNIVERSAL::isa($obj, __PACKAGE__)) {
carp "implementing peek() for $name" unless $Peek::SILENT;
my $fd = fileno($fh);
tell $fh; # XXX - this is needed to workaround a bug (!)
open my($new_io), "<&$fd" or croak "can't dup $name: $!";
tie *$fh, __PACKAGE__, $new_io;
$obj = tied *$fh;
}
push @{ $buffer{$obj} }, scalar <$obj>;
return $buffer{$obj}[-1];
}
1;
|