perl foreach eat all array content - perl

The follow code will eat content in #populations
#populations=("EUR","AFR","ASN","AMR");
print #populations,"\n"; #will show EURAFRASNAMR
foreach (#populations)
{
$filepath="tmp.txt"; #whatever text file you like
open(FILE,"<$filepath");
while(<FILE>)
{
}
}
print #populations,"\n"; #will print nothing
if change to
foreach $i (#populations)
then the array will not be eaten.
or if mark the while loop, the array will not be eaten.
I am not a perl guru, but have several years experience.
can anyone tell me why? is it a bug of perl?

Not a bug exactly, but it is a trap for the unwary. You are implicitly assigning the elements of #populations to the $_ variable, and then you are reading data from the FILE filehandle into $_, overwriting the contents of #populations.
More explicitly, your code is equivalent to:
#populations=("EUR","AFR","ASN","AMR");
print #populations,"\n"; #will show EURAFRASNAMR
foreach $_ (#populations) # $_ becomes "aliased" to the element in #populations
{
$filepath="tmp.txt"; #whatever text file you like
open(FILE,"<$filepath");
while(defined($_ = <FILE>)) # overwrites $_, and erases element in #populations
{
}
}
print #populations,"\n"; #will print nothing
You found a good workaround, which is to avoid using $_ implicitly in a for loop.

while (<$fh>) { ... }
gets replaced with
while (defined($_ = <$fh>)) { ... }
which is why the value read is available in $_. The catch is that $_ is currently aliased to an element of #populations.
As you said, you can avoid that problem by using
for my $population (#populations) {
...
while (<FILE>) { ... $_ ... }
...
}
But that can still clobber $_ from the calling sub. Here are two more robust fixes:
for (#populations) { # Or: for my $population (#populations) {
...
while (my $line = <FILE>) { ... $line ... }
...
}
or
for (#populations) { # Or: for my $population (#populations) {
...
while (local $_ = <FILE>) { ... $_ ... }
...
}
For exactly the same reason, you shouldn't use global variables for file handles.
$filepath="tmp.txt"; #whatever text file you like
open(FILE,"<$filepath");
<FILE>
should be
my $filepath="tmp.txt";
open(my $FILE, "<", $filepath) or die $!;
<$fh>
By the way, always use use strict; use warnings;.

Related

Perl script to pair two array

I want to pair two array and add char '/' between them. Let say, two arrays are like below
#array1 = (FileA .. FileZ);
#array2 = (FileA.txt .. FileZ.txt);
The output that I want is like below
../../../experiment/fileA/fileA.txt
.
.
../../../experiment/fileZ/fileZ.txt
here is my code
my #input_name = input();
my $dirname = "../../../experiment/";
# CREATE FOLDER PATH
my #fileDir;
foreach my $input_name (#input_name){
chomp $input_name;
$_ = $dirname . $input_name;
push #fileDir, $_;
}
# CREATE FILE NAME
my #filename;
my $extension = '.txt';
foreach my $input_name (#input_name){
chomp $input_name;
$_ = $input_name . $extension;
push #filename, $_;
}
The code that I'd try is like below. But it seem doesn't work
#CREATE FULL PATH
foreach my $test_path (#test_path){
foreach my $testname (#testname){
my $test = map "$test_path[$_]/$testname[$_]", 0..$#test_path;
push #file, $test;
}
}
print #file;
I assume input() returns something like ('fileA', 'fileB').
The problem with your code is the nested loop here:
foreach my $test_path (#test_path){
foreach my $testname (#testname){
This combines every $test_path with every possible $testname. You don't want that. Also, it doesn't make much sense to assign the result of map to a scalar: All you'll get is the number of elements in the list created by map.
(Also, you have random chomp calls sprinkled throughout your code. None of those should be there.)
You only need a single array and a single loop:
use strict;
use warnings;
sub input {
return ('fileA', 'fileB');
}
my #input = input();
my $dirname = '../../../experiment';
my #files = map "$dirname/$_/$_.txt", #input;
for my $file (#files) {
print "got $file\n";
}
Here the loop is hidden in the map ..., #input call. If you want to write it as a for loop, it would look like this:
my #files;
for my $input (#input) {
push #files, "$dirname/$input/$input.txt";
}
The problem is your algorithm. You're iterating all filenames and all dirnames at the same time.
I mean, your code says "For every directory, create every file".
Try something along the lines of this and you'll be fine:
# WRITE TESTFILE
foreach my $filename (#filename){
chomp $filename;
if ( -e "$filename/$filename" and -d "$filename/$filename" ){
print "File already exists\n";
}
else {
open ( TXT_FILE, ">$filename/$filename" );
print TXT_FILE "Hello World";
close TXT_FILE;
}
}

Can't find a string in array

I have a file with almost 1,500 names of Marvel heroes, each name in new line. I have to ask user what his favourite hero is and find out if it's a hero from the list or not. Here's what I have right now. It doesn't work: I can guess only the last hero from the list. For the rest it just prints that they are not on the list.
print "Whats your favourite hero?\n";
my $hero = <stdin>;
chomp $hero;
open FILE, "<list_marvel.txt";
my #marvel = <FILE>;
chomp(#marvel);
my $result = 0;
foreach (#marvel) {
if ($_ eq $hero);
}
if ($result == 1) {
print "That hero is on the list";
}
else {
print "$hero is not on the list.\n";
}
Here are two files:
-Perl code : Perl Code
-List of heroes : List
Your program has a syntax error and won't compile. It certainly won't find only the last name on the list
The main problem is that you never set $result, and if($_ eq $hero) should be something like $result = 1 if($_ eq $hero)
You must always use strict and use warnings at the top of every Perl program you write. It is an enormous help in finding straighforward problems
Here's a working version
use strict;
use warnings;
my $filename = 'list_marvel.txt';
open my $fh, '<', $filename or die qq{Unable to open "'list_marvel.txt'": $!};
print "Whats your favourite hero? ";
my $hero = <>;
chomp $hero;
my $found;
while ( <$fh> ) {
chomp;
if ( $_ eq $hero ) {
++$found;
last;
}
}
print $found ? "$hero is on the list\n" : "$hero is not on the list";
You don't set $result anywhere to true.
Make your foreach loop like this:
foreach(#marvel){
$result = $_ eq $hero;
}
or
foreach (#marvel){
$result = 1 if $_ eq $hero
}
You forgot to increment your $result. If you indent your code properly, it is easier to see.
foreach (#marvel) {
# here something is missing
if ( $_ eq $hero );
}
Add $result++ if $_ eq $hero; in the foreach.
You should always use strict and use warnings. That would have told you about a syntax error near );.
Also consider using the three argument open with lexical filehandles.
Rewritten it looks like this:
use strict;
use warnings;
use feature 'say'; # gives you say, which is print with a newline at the end
say "What's you favourite hero?";
my $hero = <STDIN>;
chomp $hero;
# alsways name variables so it's clear what they are for
my $found = 0;
# die with the reason of error if something goes wrong
open my $fh, '<', 'list_marvel.txt' or die $!;
# read the file line by line
while ( my $line = <$fh> ) {
chomp $line;
if ( $line eq $hero ) {
# increment so we know we 'found' the hero in the list
$found++;
# stop reading at the first hit
last;
}
}
close $fh;
# no need to check for 1, truth is enough
if ( $result ) {
say "That hero is on the list.";
}
else {
say "$hero is not on the list.";
}
First, you miss setting the $result at around if($_ eq $hero).
Then, you may wish to make you comparison case insensitive. This would require a regular expression, e.g.:
$result = 1 if (/^$hero$/i);
Just modified your code. After if condition increment $result. Always use use strict and use warnings and always use 3 arguments to open a file.
use strict;
use warnings;
print "Whats your favourite hero?\n";
my $hero = <stdin>;
chomp $hero;
open FILE, "<", "list_marvel.txt" or die $!;
chomp (my #marvel = <FILE>);
close FILE;
my $result = 0;
foreach my $name (#marvel)
{
if($name eq $hero)
{
$result++;
}
}
if ($result == 1)
{
print "That hero is in the list.\n";
}
else
{
print "$hero is not in the list.\n";
}
This will take a single user entry from STDIN. It will run through the file of hero names, and if one matches the user entry it will print the name and exit the loop. If the name is not found it will tell you:
use warnings;
use strict;
open my $file1, '<', 'input.txt' or die $!;
print "Enter hero: ";
chomp(my $hero = <STDIN>);
my $result = 0;
while(<$file1>){
chomp;
if (/$hero/){
print "$_\n";
$result++;
last;
}
}
print "hero not in list\n" if $result == 0;

Scope of $_ : why does this change it?

I have a code snippet like the following:
use strict;
use warnings;
# file names to search for
open(my $files, "<", "fileList.txt") or die "Can't open fileList.txt: $!";
my $flag = 0;
while (<$files>) {
print "File loop: $_\n";
open(my $search, "<", "searchMe.txt") or die "Can't open searchMe.txt: $!";
$flag = 0;
while (<$search>){
print "Search loop: $_\n";
}
}
fileList.txt contains one line: "CheckFilesFunctions.pm"
searchMe.txt contains one line: abc
The output here is
File loop: CheckFilesFunctions.pm
Search loop: abc
However. when I change the search loop to the following
while (<$search> && !$flag){
Suddenly the search loop starts printing
Search loop: CheckFilesFunctions.pm
Why does the scope of $_ change here?
while (<filehandle>) is convenient shorthand for while (defined( $_ = <filehandle> )); if you have a more complicated expression to test, you need to explicitly include the full thing:
while ( defined( $_ = <$search> ) && ! $flag ) {
though I would suggest explicitly using readline (<> can mean either readline or glob, depending on the argument; I prefer to use those directly) and using a lexical variable:
while ( defined( my $line = readline $search ) && ! $flag ) {
Alternatively, you could break out of the loop instead of modifying the condition:
while (<$search>) {
...
if (...) {
last;
Though looking at your code, you probably want to be reading the search file just once into an array before the file loop, and just looping over that array.

Perl - Use of uninitialized value in string

I started teaching myself Perl, and with the help of some Googling, I was able to throw together a script that would print out the file extensions in a given directory. The code works well, however, it will sometimes complain the following:
Use of uninitialized value $exts[xx] in string eq at get_file_exts.plx
I tried to correct this by initializing my array as follows: my #exts = (); but this did not work as expected.
#!/usr/bin/perl
use strict;
use warnings;
use File::Find;
#Check for correct number of arguments
if(#ARGV != 1) {
print "ERROR: Incorrect syntax...\n";
print "Usage: perl get_file_exts.plx <Directory>\n";
exit 0;
}
#Search through directory
find({ wanted => \&process_file, no_chdir => 1 }, #ARGV);
my #exts;
sub process_file {
if (-f $_) {
#print "File: $_\n";
#Get extension
my ($ext) = $_ =~ /(\.[^.]+)$/;
#Add first extension
if(scalar #exts == 0) {
push(#exts, $ext);
}
#Loop through array
foreach my $index (0..$#exts) {
#Check for match
if($exts[$index] eq $ext) {
last;
}
if($index == $#exts) {
push(#exts, $ext);
}
}
} else {
#print "Searching $_\n";
}
}
#Sort array
#exts = sort(#exts);
#Print contents
print ("#exts", "\n");
You need to test if you found an extension.
Also, you should not be indexing your array. You also do not need to manage 'push' just do it. It is not the Perl way. Your for loop should start like this:
sub process_file {
if (-f $_) {
#print "File: $_\n";
#Get extension
my ($ext) = $_ =~ /(\.[^.]+)$/;
# If we found an extension, and we have not seen it before, add it to #exts
if ($ext) {
#Loop through array to see if this is a new extension
my $newExt = 1;
for my $seenExt (#exts) {
#Check for match
if ($seenExt eq $ext) {
$newExt = 0
last;
}
}
if ($newExt) {
push #exts,$ext;
}
}
}
}
But what you really want to do is to use a hash table to record if you saw an extension
# Move this before find(...); if you want to initialize it or you will clobber the
# contents
my %sawExt;
sub process_file {
if (-f $_) {
#print "File: $_\n";
# Get extension
my ($ext) = $_ =~ /(\.[^.]+)$/;
# If we have an extension, mark that we've seen it
$sawExt{$ext} = 1
if $ext;
}
}
# Print the extensions we've seen in sorted order
print join(' ',sort keys %sawExt) . "\n";
Or even
sub process_file {
if (-f $_ && $_ =~ /(\.[^.]+)$/) {
$sawExt{$1} = 1;
}
}
Or
sub process_file {
$sawExt{$1} = 1
if -f && /(\.[^.]+)$/;
}
Once you start thinking in Perl this is the natural way to write it
The warning is complaining about a content of $exts[xx], not #exts itself.
Actually $ext can be undef, when the filename doesn't match to your regexp, for instance README.
Try like:
my ($ext) = $_ =~ /(\.[^.]+)$/ or return;
The main problem is that you aren't accounting for file names that don't contain a dot, so
my ($ext) = $_ =~ /(\.[^.]+)$/;
sets $ext to undef.
Despite the warning, processing continues by evaluating undef as the null string, failing to find that in #exts, and so percolating undef to the array as well.
The minimal change to get your code working is to replace
my ($ext) = $_ =~ /(\.[^.]+)$/;
with
return unless /(\.[^.]+)$/;
my $ext = $1;
But there is a couple of Perl lessons to be learned here. It used to be taught that good programs were well-commented programs. That was in the days of having to write efficient but incomprehensible code, but is no longer true. You should write code that is as clear as possible, and add comments only if you absolutely have to write something that isn't self-explanatory.
You should remember and use Perl idioms, and try to forget most C that you knew. For instance, Perl accepts the "here document" syntax, and it is common practice to use or and and as short-circuit operators. Your parameter check becomes
#ARGV or die <<END;
ERROR: Incorrect syntax...
Usage: perl get_file_exts.plx <Directory>
END
Perl allows for clear but concise programming. This is how I would have written your wanted subroutine
sub process_file {
return unless -f and /(\.[^.]+)$/;
my $ext = $1;
foreach my $index (0 .. $#exts) {
return if $exts[$index] eq $ext;
}
push #exts, $ext;
}
Use exists on $exts[xx] before accessing it.
exists is deprecated though as #chrsblck pointed out :
Be aware that calling exists on array values is deprecated and likely
to be removed in a future version of Perl.
But you should be able to check if it exists (and not 0 or "") simply with :
if($exts[index] && $exts[$index] eq $ext){
...
}

Display And Pass Command Line Arguments in Perl

I have the following program "Extract.pl", which opens a file, finds the lines containing "warning....", "info...", "disabling..." then counts and prints the value and number of them. It is working ok.
What I want to do is to create command line arguments for each of the 3 matches - warning, disabling and infos and then run either of them from the command prompt.
Here is the code:
#!/usr/bin/perl
use strict;
use warnings;
my %warnings = ();
my %infos = ();
my %disablings = ();
open (my $file, '<', 'Warnings.txt') or die $!;
while (my $line = <$file>) {
if($line =~ /^warning ([a-zA-Z0-9]*):/i) {
++$warnings{$1};
}
if($line =~ /^disabling ([a-zA-Z0-9]*):/i) {
++$disablings{$1};
}
if($line =~ /^info ([a-zA-Z0-9]*):/i) {
++$infos{$1};
}
}
close $file;
foreach my $w (sort {$warnings{$a} <=> $warnings{$b}} keys %warnings) {
print $w . ": " . $warnings{$w} . "\n";
}
foreach my $d (sort {$disablings{$a} <=> $disablings{$b}} keys %disablings) {
print $d . ": " . $disablings{$d} . "\n";
}
foreach my $i (sort {$infos{$a} <=> $infos{$b}} keys %infos) {
print $i . ": " . $infos{$i} . "\n";
}
The builtin special array #ARGV holds all command line arguments to the script, excluding the script file itself (and the interpreter, if called as perl script.pl). In the case of a call like perl script.pl foo bar warnings, #ARGV would contain the values 'foo', 'bar', and 'warnings'. It's a normal array, so you could write something like (assuming the first argument is one of your options):
my ($warning, $info, $disabling);
if ($ARGV[0] =~ /warning/i) { $warning = 1 }
elsif ($ARGV[0] =~ /info/i) { $info = 1 }
elsif ($ARGV[0] =~ /disabling/i) { $disabling = 1 }
# [...] (opening the file, starting the main loop etc...)
if ( $warning and $line =~ /^warning ([a-zA-Z0-9]*)/i ) {
++$warnings{$1};
}
elsif ( $info and $line =~ /^info ([a-zA-Z0-9]*)/i ) {
++$infos{$1};
}
elsif ( $disabling and $line =~ /^disabling ([a-zA-Z0-9]*)/i ) {
++$disablings{$1};
}
I created flag variables for the three conditions before the main loop that goes through the file to avoid a regex compilation on every line of the file.
You could also use the Getopt::Long or Getopt::Std modules. These provide easy and flexible handling of the command line arguments.