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 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: 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 = ; : :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 # &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