Article 11514 of comp.lang.perl:
Path: feenix.metronet.com!news.utdallas.edu!wupost!math.ohio-state.edu!howland.reston.ans.net!agate!boulder!wraeththu.cs.colorado.edu!tchrist
From: Tom Christiansen <tchrist@cs.Colorado.EDU>
Newsgroups: comp.lang.perl
Subject: Re: how to unread a line
Date: 14 Mar 1994 18:59:42 GMT
Organization: University of Colorado, Boulder
Lines: 154
Message-ID: <2m2c6u$dd1@lace.Colorado.EDU>
References: <CMGIvD.9Fq@sybase.com>
Reply-To: tchrist@cs.colorado.edu (Tom Christiansen)
NNTP-Posting-Host: wraeththu.cs.colorado.edu
Originator: tchrist@wraeththu.cs.colorado.edu

:-> In comp.lang.perl, David.Ferrington@Sybase.Com writes:
:Hi all,
:
:how do I unread a line being read from a file?
:
:ie: given
:		$/ = "\nFrom ";
:		$rest = <FILE>;
:
:the last characters of $rest will be  ".....\nFrom "
:and i'd like to put the "From " back onto the input stack as it were
:I guess this is possible, but how.
:What i actually want to do is read the rest of a email message until the next
:message.

While I think you should probably find a better way to do it, I once wrote
this as an exercise.  I found it to be more complex than I thought it would
be, mostly due to the interaction of putting and getting both lines and
characters from the same filehandle.

-tom

package pushback;

# Functions:
#	&open(FH, path)		        like regular open
#	&close(FH)			like regular close
#
#	&getline(FH)			like <FH>
#	&getc(FH)			like getc(FH)
#
#	&ungetline(FH,list)		puts list of lines back in LIFO order
#	&ungetc(FH,string)		prepends string to next gotten line
#
#	&flushin(FH)			clears FH's pushback buffer
#	&eof(FH)			is pushback empty AND real eof?


# PACKAGE "GLOBALS"  (In Capital Letters)
# 	1) Each filehandle in any package has an array @pushback'${package}_${fh}__lines
#		containing the pushback buffer.
#
#	2) @PB_Lines is an alias for that per-filehandle buffer
#
#	3) %Ungotten is indexed by filehandle and tells us whether
#		there are pushed back chars (rather than lines)

sub main'getline {
    local($fh, *PB_Lines) = &getputback;

    # shouldn't have to check wantarray here -- it should know better
    if (!@PB_Lines) {
	if (wantarray) {
	   local(@list);
	   return @list = <$fh>;
	} else {
	   return scalar <$fh>;
	}
    }

    if (!wantarray) {
	if ($Ungotten{$fh}) {
	    $Ungotten{$fh} = 0;
	    return pop(@PB_Lines).<$fh>;
	}
	return pop @PB_Lines;
    }

    if ($Ungotten{$fh}) {
	$PB_Lines[0] .= <$fh>;
	$Ungotten{$fh} = 0;
    }

    local(@rlist) = reverse(@PB_Lines);
    @PB_Lines = ();
    push(@rlist, <$fh>);
    return @rlist;
}

sub main'ungetline {
    local($fh, *PB_Lines) = &getputback;
    if ($Ungotten{$fh}) {
	$PB_Lines[0] .= shift;
	$Ungotten{$fh} = 0;
    }
    push(@PB_Lines,reverse @_) if @_;
}

sub main'getc {
    local($fh, *PB_Lines) = &getputback;
    local($char);

    if (@PB_Lines) {
	$char = substr($PB_Lines[0], 0, 1);
	$Ungotten{$fh}--;
	substr($PB_Lines[0], 0, 1) = '';
    } else {
	$char = getc($fh);
    }
    return $char;
}

sub main'ungetc {
    local($fh, *PB_Lines) = &getputback;
    local($char) = $_[0];
    $Ungotten{$fh} += length($char) 	unless @PB_Lines;
    substr($PB_Lines[0], 0, 0) = $char;
}


sub main'eof {
    local($fh, *PB_Lines) = &getputback;
    @PB_Lines == 0 && eof($fh);
}

sub main'open {
    local($fh, *PB_Lines) = &getputback;
    local($path) = shift;
    @PB_Lines = ();
    open($fh, $path);
}

sub main'close {
    local($fh, *PB_Lines) = &getputback;
    @PB_Lines = ();
    close($fh);
}

sub main'flushin {
    local($fh, *PB_Lines) = &getputback;
    local(@buf) = @PB_Lines;
    @PB_Lines = ();
    return @buf;
}

sub getputback {
    local($myfh) = shift || STDIN;
    local($package) = caller(1); # my grandparent
    local($ptrnam) = $myfh;
    $ptrnam =~ s/^[^']+$/$package'$&/;
    $ptrnam =~ s/'/_/;
    return ($myfh, "pushback'${ptrnam}__lines");
}

# make some aliases just in case...

*main'ungetchar = *main'ungetc;
*main'getchar   = *main'getc;

1;
--
    Tom Christiansen      tchrist@cs.colorado.edu
      "Will Hack Perl for Fine Food and Fun"
	Boulder Colorado  303-444-3212