Article 11514 of comp.lang.perl:

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 <[email protected]>
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: <[email protected]>
References: <[email protected]>
Reply-To: [email protected] (Tom Christiansen)
NNTP-Posting-Host: wraeththu.cs.colorado.edu
Originator: [email protected]

:-> In comp.lang.perl, [email protected] 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 [email protected]
"Will Hack Perl for Fine Food and Fun"
Boulder Colorado 303-444-3212