Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation

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

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


  use Peek;
  use strict;
  use warnings;

  open FOO, "< somefile" or die "can't open somefile: $!";

  while (<FOO>) {
    print "Current line '$_'\n";
    chomp(my $next = peek FOO);
    print "Next line will be '$next'\n";

  close FOO;


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
object the first time you call C<peek()> on it.  To silence this, set 
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
object, or else the code breaks (in certain conditions).

=head1 AUTHOR

Jeff C<japhy> Pinyan, F<>

Inspired by F<>.


  my ($class, $io) = @_;
  bless $io, $class;

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

Comment on
Download Code

Back to Snippets Section

Log In?

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

How do I use this? | Other CB clients
Other Users?
Others pondering the Monastery: (8)
As of 2016-02-13 11:53 GMT
Find Nodes?
    Voting Booth?

    How many photographs, souvenirs, artworks, trophies or other decorative objects are displayed in your home?

    Results (429 votes), past polls