Based on the answer provided here, I am attempting to validate whether or not a perl module is installed.
For this, I have:
# &getYN and &prompt are only included here for completeness
sub getYN {
unless ( $autoyes =~ /[Yy]/ ) {
my ( $prompt, $default ) = #_;
my $defaultValue = $default ? "[$default]" : "";
print "$prompt $defaultValue: ";
chomp( my $input = <STDIN> );
return $input ? $input : $default;
} else {
return "Y";
}
}
sub prompt {
my ( $prompt, $default ) = #_;
my $defaultValue = $default ? "[$default]" : "";
print "$prompt $defaultValue: ";
chomp( my $input = <STDIN> );
return $input ? $input : $default;
}
&chklib("RRDTool::OO");
sub chklib {
my $lib = shift;
eval { require $lib; };
if ($#) {
print "You are missing a required Perl Module: $lib\n";
my $ok = &getYN( "Shall I attempt to install it for you?", "y" );
if ( $ok =~ /[Yy]/ ) {
require CPAN;
CPAN::install($lib);
} else {
print "Installation requires $lib\n";
exit;
}
}
}
This runs as expected, but for some reason, the eval returns that I don't have RRDTool::OO installed, when, in fact, I do.
If I create an empty file and run:
# File foo.pl
use strict;
$| = 1;
use RRDTool::OO;
Then I get no errors.
But when I run the first file with print $#;, it returns:
Can't locate RRDTool::OO in ...
What am I doing wrong?
You have to check the result of the eval, like
if (eval("require xxx;")) {
print "you have it\n";
} else {
print "you don't\n";
}
What is happening is that
$lib = "RRDTool::OO";
eval { require $lib }
is executed with the stringified expression
require "RRDTool::OO"
not the bareword style
require RRDTool::OO
so it is looking for a file called RRDTool::OO in your #INC path instead of a file called RRDTool/OO.pm.
If you want to use require at run-time with a variable expression, you'll want to either use the stringy form of eval
eval "require $lib"
or process the arg to require yourself
$lib = "RRDTool::OO";
$lib =~ s{::}{/}g;
eval { require "$lib.pm" }
Related
I am making a score-keeping script in Perl, and would like to have it ask how many players there are, and ask for a name, then score, for each player. I have a good bit of this script done, but only for 3 players. the current script can be found on github here: skore
(from link:)
#!/usr/bin/env perl
use strict;
my $version = "1.0";
my $arg = shift(#ARGV);
my $subname = $arg;
if (!defined($arg)){
cmd_go();
}
$subname =~ s/-/_/g;
my $sub = main->can("cmd_$subname") || main->can("dev_$subname") || main->can("hid_$subname");
if (!defined($sub))
{
print STDERR "Invalid command given.\nUse \e[1;32m./skore help\e[0m for a list of commands.\n";
exit 1;
}
else
{
$sub->(#ARGV);
exit 0;
}
# Main command
sub cmd_go()
{
print "\e[2J\e[0G\e[0d"; # J = Erase in Display, 2 = Entire Screen, (G, d) = Move cursor to (..,..)
print "••••••••••••••••••••\n";
print "• Welcome to \e[1;32mskore\e[0m •\n";
print "••••••••••••••••••••\n\n";
my #game = prompt("What game are we scoring?\n");
print "••• Game name locked: #game\n\n";
my #p1name = prompt("Player 1 name?\n");
my #p2name = prompt("Player 2 name?\n");
my #p3name = prompt("Player 3 name?\n");
print "\n";
print "••• Player names locked: #p1name #p2name #p3name\n\n";
my #p1score = prompt_num("score for #p1name?\n");
my #p2score = prompt_num("score for #p2name?\n");
my #p3score = prompt_num("score for #p3name?\n");
print "\n";
print "••• Game: #game\n";
print "••• #p1name\n";
print "••••• \e[1;32m#p1score\e[0m\n";
print "••• #p2name\n";
print "••••• \e[1;32m#p2score\e[0m\n";
print "••• #p3name\n";
print "••••• \e[1;32m#p3score\e[0m\n";
exit 1;
}
sub cmd_help()
{
print "To get right into using skore, simply type ./skore\n";
print "For details about skore, such as version, use ./skore pkg\n";
}
sub cmd_pkg()
{
print "skore version: $version\n";
print "Detected OS: ";
exec "uname -r";
}
sub prompt {
my ($query) = #_; # take a prompt string as argument
local $| = 1; # activate autoflush to immediately show the prompt
print $query;
chomp(my $answer = <STDIN>); return $answer;
}
sub prompt_num {
NSTART:
my ($querynum) = #_;
print $querynum;
chomp(my $pnum = <STDIN>);
if ($pnum eq $pnum+0) { return $pnum; }
else { print "Error: That is not a number. Try again.\n"; goto NSTART; }
}
sub prompt_yn {
my ($queryyn) = #_;
my $answer = prompt("$queryyn (y/N): ");
return lc($answer) eq 'y';
}
I'd like to also point out that I'm new to perl.
OK, wow. Stop for a moment, step back and put the code down. Think about what you're trying to accomplish here.
There's a bunch of things you're doing in your code that's really going to benefit from taking a step back, and understanding what's going on, before proceeding.
First off:
my $arg = shift(#ARGV);
my $subname = $arg;
if (!defined($arg)){
cmd_go();
}
What is this intended to do? You only use $arg 3 times here, and one of those is to copy it to $subname.
This could be quite simplified by:
my $subname = shift;
cmd_go() unless defined $subname;
Now this:
my $sub = main->can("cmd_$subname") || main->can("dev_$subname") || main->can("hid_$subname");
Where did that come from? Because I'm pretty sure that - as a beginner to perl - you didn't write that yourself, not least because you don't have any subroutines prefixed with dev_ or hid. And this sort of redirect is serious overkill for a program that basically does just one thing.
(And normally, you'd use flags like getopt rather than a command that you leave blank in a default state).
You are also massively overusing arrays - which suggests you're not really sure the difference between #game and $game.
E.g. this:
my #game = prompt("What game are we scoring?\n");
prompt does this though:
chomp(my $answer = <STDIN>); return $answer;
It returns a scalar (a single line) and you're putting it into an array for - as far as I can tell - no particular reason.
Likewise this:
my #p1score = prompt_num("score for #p1name?\n");
my #p2score = prompt_num("score for #p2name?\n");
my #p3score = prompt_num("score for #p3name?\n");
First off - you're using a bunch of single element arrays. But then you're numbering them. When ... actually, the whole point of arrays is to have numbered values.
So how about instead:
print "Num players?:\n";
chomp ( my $num = <STDIN> );
my #players;
my %scores;
for ( 1..$num ) {
print "Player name\n";
chomp ( my $name = <STDIN> );
push ( #players, $name );
}
foreach my $person ( #players ) {
print "Score for $person:\n";
chomp ( my $score = <STDIN> );
while ( $score =~ /\D/ ) {
print "Invalid - please enter numeric value\n";
chomp ( $score = <STDIN> );
}
$scores{$person} = $score;
}
foreach my $person ( #players ) {
print "$person => $score{$person}\n";
}
There are a bunch of other things that you're doing that is more complicated than it needs to be.
What I would suggest you do:
go re-read the perl basics. perldata in particular.
have a look at getopt which is a good (and standard) way to take program 'flag' style input. (e.g. showing version, if that's what you really want.
it looks a lot like you've cargo-culted the code here. I would suggest you re-write from the ground up, and when you hit a problem - ask about it on Stack Overflow, if you can't figure it out from the perl docs.
Try this. Hope this is what you wanted.
#!/usr/bin/env perl
use strict;
my $version = "1.0";
my $arg = shift(#ARGV);
my $subname = $arg;
if (!defined($arg)){
cmd_go();
}
$subname =~ s/-/_/g;
my $sub = main->can("cmd_$subname") || main->can("dev_$subname") || main->can("hid_$subname");
if (!defined($sub))
{
print STDERR "Invalid command given.\nUse \e[1;32m./skore help\e[0m for a list of commands.\n";
exit 1;
}
else
{
$sub->(#ARGV);
exit 0;
}
# Main command
sub cmd_go()
{
print "\e[2J\e[0G\e[0d"; # J = Erase in Display, 2 = Entire Screen, (G, d) = Move cursor to (..,..)
print "••••••••••••••••••••\n";
print "• Welcome to \e[1;32mskore\e[0m •\n";
print "••••••••••••••••••••\n\n";
my #game = prompt("What game are we scoring?\n");
print "••• Game name locked: #game\n\n";
my $players= prompt("Enter total number of players:\n");
my #players_list;
for(my $i=0;$i<$players;$i++){
push(#players_list , prompt("Enter Player ".($i+1)." name\n"));
}
print "\n";
print "••• Player names locked: ";
for(my $i=0;$i<$players;$i++){
print $players_list[$i]."\t";
}
print "\n\n";
my #players_score;
for(my $i=0;$i<$players;$i++){
push(#players_score, prompt("score for $players_list[$i]?\n"));
}
print "\n";
print "••• Game: #game\n";
for(my $i=0;$i<$players;$i++){
print "$players_list[$i]\n";
print "••••• \e[1;32m$players_score[$i]\e[0m\n";
}
exit 1;
}
sub cmd_help()
{
print "To get right into using skore, simply type ./skore\n";
print "For details about skore, such as version, use ./skore pkg\n";
}
sub cmd_pkg()
{
print "skore version: $version\n";
print "Detected OS: ";
exec "uname -r";
}
sub prompt {
my ($query) = #_; # take a prompt string as argument
local $| = 1; # activate autoflush to immediately show the prompt
print $query;
chomp(my $answer = <STDIN>); return $answer;
}
sub prompt_num {
NSTART:
my ($querynum) = #_;
print $querynum;
chomp(my $pnum = <STDIN>);
if ($pnum eq $pnum+0) { return $pnum; }
else { print "Error: That is not a number. Try again.\n"; goto NSTART; }
}
sub prompt_yn {
my ($queryyn) = #_;
my $answer = prompt("$queryyn (y/N): ");
return lc($answer) eq 'y';
}
I'm trying to populate the grep result to csv file. But it is showing the following error.
"Use of uninitialized value in concatenation (.) or string at"
code:
sub gen_csv {
my $db_ptr = shift #_;
my $cvs_file_name = shift #_;
open( FILE, ">$cvs_file_name" ) or die("Unable to open CSV FILE $cvs_file_name\n");
print FILE "Channel no, Page no, \n";
foreach my $s ( #{$db_ptr} ) {
my $tmp = "$s->{'ch_no'},";
$tmp .= "$s->{'pg_no'},";
print FILE $tmp;
}
close(FILE);
}
sub parse_test_logs {
my $chnl;
my $page;
my $log = "sample.log";
open my $log_fh, "<", $log;
while ( my $line = <$log_fh> ) {
if ( $line =~ /(.*):.*solo_(.*): queueing.*/ ) {
my $chnl = $1;
my $page = $2;
}
my %test_details = (
'ch_no' => $chnl,
'pg_no' => $page, # <- was missing closing single quote
);
push( #{$dba_ptr}, \%test_details );
}
close log_fh;
}
Any suggestions on what i'm missing out?
(i'm getting the above error pointing to my $tmp = "$s->{'ch_no'},"; in gen_csv module)
Most likely this is due to NULL values in your DB records or the keys you are using are wrong. Either way, the warning is because the ch_no value does not exist.
If you don't care about NULL values, and you are fine with some of the values being missing, then you can suppress warnings for uninitialized values.
no warnings 'uninitialized';
Your problem involves this block:
if ( $line =~ /(.*):.*solo_(.*): queueing.*/ ) {
my $chnl = $1;
my $page = $2;
}
my %test_details = (
'ch_no' => $chnl,
'pg_no' => $page,
);
You're capturing your variables, but you have them declared with my within the if block. Those lexicals then go out of scope and are undef when used to initialize the hash.
I recommend simplifying your parsing function to the following:
sub parse_test_logs {
my $log = "sample.log";
open my $log_fh, "<", $log;
while (<$log_fh>) {
if ( my ( $chnl, $page ) = /(.*):.*solo_(.*): queueing.*/ ) {
push #{$dba_ptr}, { 'ch_no' => $chnl, 'pg_no' => $page };
} else {
warn "regex did not match for line $.: $_";
}
}
close $log_fh;
}
Finally, it's possible that you already are, but I just want to pass on the ever necessary advice to always include use strict; and use warnings; at the top of EVERY Perl script.
Would it be OK to keep the END block in this example, because nobody wants a broken terminal or shouldn't I put an END block in a module?
package My_Package;
use warnings;
use strict;
use Term::ReadKey;
sub _init_scr {
my ( $arg ) = #_;
$arg->{backup_flush} = $|;
$| = 1;
Term::ReadKey::ReadMode 'ultra-raw';
}
sub _end_win {
my ( $arg ) = #_;
print "\n\r";
Term::ReadKey::ReadMode 'restore';
$| = $arg->{backup_flush};
}
END {
Term::ReadKey::ReadMode 'restore';
}
sub my_function {
my $arg = {};
_init_scr( $arg );
while ( 1 ) {
my $c = ReadKey 0;
if ( ! defined $c ) {
_end_win( $arg );
warn "EOT";
return;
}
next if $c eq "\e";
given ( $c ) {
when ( $c ge 'a' && $c le 'z' ) {
print $c;
$arg->{string} .= $c;
}
when ( $c eq "\cC" ) {
_end_win( $arg );
print STDERR "^C";
kill( 'INT', $$ );
return;
}
when ( $c eq "\r" ) {
_end_win( $arg );
return $arg->{string};
}
}
}
}
If your module changes the terminal mode, then I would think the most polite thing to do would be for it to also install an END block to restore the terminal mode before the program exits.
No, it's polite and expected that you put things back as you found them.
However, it's unwelcome to tidy up someone else's workspace unless you've been asked to do so.
That is, your END routine shouldn't run unless it has reason to do so, and your module probably ought to allow a developer to disable the automatic cleanup. (E.g., use My_Package qw(:no_auto_restore).)
Failing that, the POD ought to explicitly document that the module fiddles with a system resource upon exit.
I am working on a very large, very old "historically grown" codebase. In the past, there were often people thinking "Oh, I may need this and that module, so I just include it...", and later, people often "cached" Data inside of modules ("use ThisAndThat" needing a few seconds to load some hundred MB from DB to RAM, yeah, its really a stupid Idea, we are working on that too) and so, often, we have a small module use'ing like 20 or 30 modules, from who 90% are totally unused in the source itself, and, because of "caching" in several use'd submodules, modules tend to take up one minute to load or even more, which is, of course, not acceptable.
So, Im trying to get that done better. Right now, my way is looking through all the modules, understanding them as much as possible and I look at all the modules including them and see whether they are needed or not.
Is there any easier way? I mean: There are functions returning all subs a module has like
...
return grep { defined &{"$module\::$_"} } keys %{"$module\::"}
, so, aint there any simple way to see which ones are exported by default and which ones come from where and are used in the other modules?
A simple example is Data::Dumper, which is included in nearly every file, even, when all debug-warns and prints and so on arent in the script anymore. But still the module has to load Data::Dumper.
Is there any simple way to check that?
Thanks!
The following code could be part of your solution - it will show you which symbols are imported for each instance of use:
package traceuse;
use strict;
use warnings;
use Devel::Symdump;
sub import {
my $class = shift;
my $module = shift;
my $caller = caller();
my $before = Devel::Symdump->new($caller);
my $args = \#_;
# more robust way of emulating use?
eval "package $caller; require $module; $module\->import(\#\$args)";
my $after = Devel::Symdump->new($caller);
my #added;
my #after_subs = $after->functions;
my %before_subs = map { ($_,1) } $before->functions;
for my $k (#after_subs) {
push(#added, $k) unless $before_subs{$k};
}
if (#added) {
warn "using module $module added: ".join(' ', #added)."\n";
} else {
warn "no new symbols from using module $module\n";
}
}
1;
Then just replace "use module ..." with "use traceuse module ...", and you'll get a list of the functions that were imported.
Usage example:
package main;
sub foo { print "debug: foo called with: ".Dumper(\#_)."\n"; }
use traceuse Data::Dumper;
This will output:
using module Data::Dumper added: main::Dumper
i.e. you can tell which functions were imported in robust way. And you can easily extend this to report on imported scalar, array and hash variables - check the docs on Devel::Symdump.
Determine which functions are actually used is the other half of the equation. For that you might be able to get away with a simple grep of your source code - i.e. does Dumper appear in the module's source code that's not on a use line. It depends on what you know about your source code.
Notes:
there may be a module which does what traceuse does - I haven't checked
there might be a better way to emulate "use" from another package
I kind of got of got it to work with PPI. It looks like this:
#!/usr/local/bin/perl
use strict;
use warnings;
use Data::Dumper;
use Term::ANSIColor;
use PPI;
use PPI::Dumper;
my %doneAlready = ();
$" = ", ";
our $maxDepth = 2;
my $showStuffOtherThanUsedOrNot = 0;
parse("/modules/Test.pm", undef, undef, 0);
sub parse {
my $file = shift;
my $indent = shift || 0;
my $caller = shift || $file;
my $depth = shift || 0;
if($depth && $depth >= $maxDepth) {
return;
}
return unless -e $file;
if(exists($doneAlready{$file}) == 1) {
return;
}
$doneAlready{$file} = 1;
my $skript = PPI::Document->new($file);
my #included = ();
eval {
foreach my $x (#{$skript->find("PPI::Statement::Include")}) {
foreach my $y (#{$x->{children}}) {
push #included, $y->{content} if (ref $y eq "PPI::Token::Word" && $y->{content} !~ /^(use|vars|constant|strict|warnings|base|Carp|no)$/);
}
}
};
my %double = ();
print "===== $file".($file ne $caller ? " (Aufgerufen von $caller)" : "")."\n" if $showStuffOtherThanUsedOrNot;
if($showStuffOtherThanUsedOrNot) {
foreach my $modul (#included) {
next unless -e createFileName($modul);
my $is_crap = ((exists($double{$modul})) ? 1 : 0);
print "\t" x $indent;
print color("blink red") if($is_crap);
print $modul;
print color("reset") if($is_crap);
print "\n";
$double{$modul} = 1;
}
}
foreach my $modul (#included) {
next unless -e createFileName($modul);
my $anyUsed = 0;
my $modulDoc = parse(createFileName($modul), $indent + 1, $file, $depth + 1);
if($modulDoc) {
my #exported = getExported($modulDoc);
print "Exported: \n" if(scalar #exported && $showStuffOtherThanUsedOrNot);
foreach (#exported) {
print(("\t" x $indent)."\t");
if(callerUsesIt($_, $file)) {
$anyUsed = 1;
print color("green"), "$_, ", color("reset") if $showStuffOtherThanUsedOrNot;
} else {
print color("red"), "$_, ", color("reset") if $showStuffOtherThanUsedOrNot;
}
print "\n" if $showStuffOtherThanUsedOrNot;
}
print(("\t" x $indent)."\t") if $showStuffOtherThanUsedOrNot;
print "Subs: " if $showStuffOtherThanUsedOrNot;
foreach my $s (findAllSubs($modulDoc)) {
my $isExported = grep($s eq $_, #exported) ? 1 : 0;
my $rot = callerUsesIt($s, $caller, $modul, $isExported) ? 0 : 1;
$anyUsed = 1 unless $rot;
if($showStuffOtherThanUsedOrNot) {
print color("red") if $rot;
print color("green") if !$rot;
print "$s, ";
print color("reset");
}
}
print "\n" if $showStuffOtherThanUsedOrNot;
print color("red"), "=========== $modul wahrscheinlich nicht in Benutzung!!!\n", color("reset") unless $anyUsed;
print color("green"), "=========== $modul in Benutzung!!!\n", color("reset") if $anyUsed;
}
}
return $skript;
}
sub createFileName {
my $file = shift;
$file =~ s#::#/#g;
$file .= ".pm";
$file = "/modules/$file";
return $file;
}
sub getExported {
my $doc = shift;
my #exported = ();
eval {
foreach my $x (#{$doc->find("PPI::Statement")}) {
my $worthATry = 0;
my $isMatch = 0;
foreach my $y (#{$x->{children}}) {
$worthATry = 1 if(ref $y eq "PPI::Token::Symbol");
if($y eq '#EXPORT') {
$isMatch = 1;
} elsif($isMatch && ref($y) ne "PPI::Token::Whitespace" && ref($y) ne "PPI::Token::Operator" && $y->{content} ne ";") {
push #exported, $y->{content};
}
}
}
};
my #realExported = ();
foreach (#exported) {
eval "\#realExported = $_";
}
return #realExported;
}
sub callerUsesIt {
my $subname = shift;
my $caller = shift;
my $namespace = shift || undef;
my $isExported = shift || 0;
$caller = `cat $caller`;
unless($namespace) {
return 1 if($caller =~ /\b$subname\b/);
} else {
$namespace = createPackageName($namespace);
my $regex = qr#$namespace(?:::|->)$subname#;
if($caller =~ $regex) {
return 1;
}
}
return 0;
}
sub findAllSubs {
my $doc = shift;
my #subs = ();
eval {
foreach my $x (#{$doc->find("PPI::Statement::Sub")}) {
my $foundName = 0;
foreach my $y (#{$x->{children}}) {
no warnings;
if($y->{content} ne "sub" && ref($y) eq "PPI::Token::Word") {
push #subs, $y;
}
use warnings;
}
}
};
return #subs;
}
sub createPackageName {
my $name = shift;
$name =~ s#/modules/##g;
$name =~ s/\.pm$//g;
$name =~ s/\//::/g;
return $name;
}
Its really ugly and maybe not 100% working, but it seems, with the tests that Ive done now, that its good for a beginning.
Perl has some special handling for the readline function (and the equivalent <> I/O operator) where it treats the expressions
while (<HANDLE>)
while (readline(HANDLE))
as equivalent to
while (defined($_ = <HANDLE>))
cf.
$ perl -MO=Deparse -e 'f($_) while <>'
f($_) while defined($_ = <ARGV>); <--- implicitly sets $_
-e syntax OK
But this automatic assignment doesn't seem to happen if you hijack the readline function:
$ perl -MO=Deparse -e 'BEGIN {
> *CORE::GLOBAL::readline = sub { }
> }
> f($_) while <>'
sub BEGIN {
*CORE::GLOBAL::readline = sub {
};
}
f($_) while readline(ARGV); <--- doesn't set $_ !
-e syntax OK
Of course, this will make the custom readline function work incorrectly for a lot of legacy code. The output of this code is "foo" with the BEGIN block and "bar" without it, but I want it to be "BAR".
use warnings;
BEGIN { *CORE::GLOBAL::readline = \&uc_readline; }
sub uc_readline {
my $line = CORE::readline(shift || *ARGV);
return uc $line if defined $line;
return;
}
($_, $bar) = ("foo\n", "bar\n");
open X, '<', \$bar;
while (<X>) {
print $_; # want and expect to see "BAR\n"
}
What options do I have to hijack the readline function but still get the proper treatment of the while (<...>) idiom? It's not practical to explicitly convert everything to while (defined($_=<...>)) in all the legacy code.
This is a fairly dirty hack using overloading to detect boolean context, but it seems to do the trick. It certainly needs more testing than I have given it before using this solution in a production environment:
use warnings;
BEGIN { *CORE::GLOBAL::readline = \&uc_readline; }
sub uc_readline {
my $line = CORE::readline(shift || *ARGV);
return Readline->new(uc $line) if defined $line;
return;
}
{package Readline;
sub new {shift; bless [#_]}
use overload fallback => 1,
'bool' => sub {defined($_ = $_[0][0])}, # set $_ in bool context
'""' => sub {$_[0][0]},
'+0' => sub {$_[0][0]};
}
my $bar;
($_, $bar) = ("foo\n", "bar\n");
open X, '<', \$bar;
while (<X>) {
print $_; # want and expect to see "BAR\n"
}
which prints:
BAR
This will also make if (<X>) {...} set $_. I don't know if there is a way to limit the magic to only while loops.
This code:
use warnings;
BEGIN { *CORE::GLOBAL::readline = \&uc_readline; }
sub uc_readline {
my $line = CORE::readline(shift || *ARGV);
return unless defined $line;
$line = uc $line;
$_ = $line;
return $line;
}
($_, $bar) = ("foo\n", "bar\n");
open X, '<', \$bar;
while (<X>) {
print $_; # want and expect to see "BAR\n"
}
print "$_"; # prints "BAR" instad of "foo"
does almost the right thing, but $_ is not localised, so after the loop, $_ is set to the last value read from the filehandle. Adding Scope::Upper to the mix fixes that:
use warnings;
use Scope::Upper qw/localize SCOPE/;
BEGIN { *CORE::GLOBAL::readline = \&uc_readline; }
sub uc_readline {
my $line = CORE::readline(shift || *ARGV);
return unless defined $line;
$line = uc $line;
local $_ = $line;
# localize $_ in the scope of the while
localize *main::_, \$line, SCOPE(1);
return $line;
}
($_, $bar) = ("foo\n", "bar\n");
open X, '<', \$bar;
while (<X>) {
print "$_"; # want and expect to see "BAR\n"
}
print "$_"; # will print 'foo', not "BAR"