Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
PerlMonks  

Peek.pm

by japhy (Canon)
on Jul 11, 2002 at 20:05 UTC ( [id://181129]=CUFP: print w/replies, xml ) Need Help??

Inspired by How to 'peek' at next line while parsing with <>. Update: subclassed Tie::StdHandle, shortened the code considerably.
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;

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: CUFP [id://181129]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others imbibing at the Monastery: (3)
As of 2025-07-10 16:36 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?
    erzuuliAnonymous Monks are no longer allowed to use Super Search, due to an excessive use of this resource by robots.