Debug a Perl script - perl

I already did some research on Perl script debugging but couldn't find what I was looking for.
Let me explain my problem here.
I have a Perl script which is not entering into last while loop it seems cos it is not printing anything inside as instructed.
So, I want to know is there any easier method available to see all lines one by one like we can see in shell script using
set -x
Here is my Perl script code
#!/usr/bin/perl -w
my $ZONEADM = "/usr/sbin/zoneadm list -c";
use strict;
use diagnostics;
use warnings;
system("clear");
print "Enter the app\n";
chomp(my $INS = <>);
print "\nEnter the Symmitrix ID\n";
chomp(my $SYMM = <>);
print "\nEnter the Server\n";
chomp(my $SRV = <>);
print "\nEnter the devices\n";
while (<>) {
if($_ !~ m/(q|quit)/) {
chomp($_);
my $TEMP_FILE = "/export/home/ptiwari/scripts/LOG.11";
open (my $FH, '>>', $TEMP_FILE);
my #arr = split(/:/, $_);
if($arr[3]) {
print $FH "/".$INS."db/".$arr[0]." ".$SYMM." ".$arr[1]." ".$arr[2]." ".$arr[3]."\n";
}
else {
print $FH "/".$INS."db/".$arr[0]." ".$SYMM." ".$arr[1]." ".$arr[2]."\n";
}
undef #arr;
close $FH;
}
else {
exit;
}
}
my $IS_ZONE = qx($ZONEADM|grep -i $SRV|grep -v global);
if($IS_ZONE) {
$IS_ZONE = "yes";
}
else {
$IS_ZONE = "no";
}
open(my $FLH, '<', "/export/home/ptiwari/scripts/LOG.11");
my #lines;
while(<$FLH>) {
my ($GLOBAL_MTPT, $SYM, $SYM_DEV, $SIZE, $NEWFS) = split;
print $GLOBAL_MTPT." ".$SYM." ".$SYM_DEV;
print "\n";
}
I already tried perl -d but it didn't show me anything which can help me to troubleshoot why it didn't enter the while loop.

Your while(<>) loop doesn't have sensible termination conditions. The /q|quit/ regex is buggy.
You exit the whole script if any line contains q or quit. You will also exit, if the device descriptions contains things like quill or acquisition. The effect of typing an accidental q is similar to a CtrlC.
The only way to finish the loop and go on with the script is to send an EOF. This requires the user to punch CtrlD into the keyboard, or a file to simply end. Then your script will continue.
There are some other things wrong/weird with this script.
Main criticism: (a) all-uppercase variables are informally reserved for Perl and pragmatic modules. Lowercase or mixed case variables work too. (b) Your script contains quite some redundant code. Either refactor it into subs, or rewrite your logic
Here is an example rewrite that may be easier to debug / may not contain some of the bugs.
#!/usr/bin/perl
use strict;
use warnings;
use diagnostics;
use constant DEBUG_FLAG => 1; # set to false value for release
my $zoneadm_command = "/usr/sbin/zoneadm list -c";
my $temp_file_name = "/export/home/ptiwari/scripts/LOG.11";
sub prompt { print "\n", $_[0], "\n"; my $answer = <>; chomp $answer; return $answer }
sub DEBUG { print STDERR "DEBUG> ", #_, "\n" if DEBUG_FLAG }
system("clear");
my $app_name = prompt("Enter the app");
my $symm_id = prompt("Enter the Symmitrix ID");
my $server = prompt("Enter the server name");
print "Enter the devices.\n";
print qq(\tTo terminate the script, type "q" or "quit".\n);
print qq(\tTo finish the list of devices, type Ctrl+D.\n);
open my $temp_file, ">>", $temp_file_name
or die "Can't open log file: $!";
while (<>) {
chomp; # remove trailing newline
exit if /^q(?:uit)?$/; # terminate the script if the input line *is* `q` or `quit`.
my #field = split /:/;
# grep: select all true values
#field = grep {$_} ("/${app_name}db/$field[0]", $symm_id, #field[1 .. 3]);
print $temp_file join(" ", #field), "\n";
}
close $temp_file;
DEBUG("finished the reading loop");
# get the zones with only *one* extra process
my #zones =
grep {not /global/}
grep {/\Q$server\E/i}
map {chomp; $_}
qx($zoneadm_command);
my $is_zone = #zones ? "yes" : "no";
DEBUG("Am I in the zone? $is_zone");
open my $device_file, "<", $temp_file_name or die "Can't open $temp_file_name: $!";
while (<$device_file>) {
chomp;
my ($global_mtpt, $sym, $sym_dev) = split;
print join(" ", $global_mtpt, $sym, $sym_dev), "\n";
# or short: print join(" ", (split)[0 .. 2]), "\n";
}

You need something like this for stepping into the script:
http://www.devshed.com/c/a/Perl/Using-The-Perl-Debugger/

You can really use the debugger: http://perldoc.perl.org/perldebug.html
But if your preference is to trace like bash -x, take a look at this discussion:
http://www.perlmonks.org/?node_id=419653

The Devel::Trace Perl module is designed to mimic sh -x tracing for shell programs.

Try to remove the "my $" from the last open statement and the "$" from there in the last while statement. Or better yet, try this:
open(my FLH, '<', "/export/home/ptiwari/scripts/LOG.11");
my #lines = <FLH>;
foreach (#lines) {
my ($GLOBAL_MTPT, $SYM, $SYM_DEV, $SIZE, $NEWFS) = split;
print $GLOBAL_MTPT." ".$SYM." ".$SYM_DEV;
print "\n";
}
Let me know about the results.

Related

Parsing data from delimited blocks

I have a log file content many blocks /begin CHECK ... /end CHECK like below:
/begin CHECK
Var_AAA
"Description AAA"
DATATYPE UBYTE
Max_Value 255.
ADDRESS 0xFF0011
/end CHECK
/begin CHECK
Var_BBB
"Description BBB"
DATATYPE UBYTE
Max_Value 255.
ADDRESS 0xFF0022
/end CHECK
...
I want to extract the variable name and its address, then write to a new file like this
Name Address
Var_AAA => 0xFF0011
Var_BBB => 0xFF0022
I am just thinking about the ($start, $keyword, $end) to check for each block and extract data after keyword only
#!/usr/bin/perl
use strict;
use warnings;
my $input = 'input.log';
my $output = 'output.out';
my ( $start, $keyword, $end ) = ( '^\/begin CHECK\n\n', 'ADDRESS ', '\/end CHECK' );
my #block;
# open input file for reading
open( my $in, '<', $input ) or die "Cannot open file '$input' for reading: $!";
# open destination file for writing
open( my $out, '>', $output ) or die "Cannot open file '$output' for writing: $!";
print( "copying variable name and it's address from $input to $output \n" );
while ( $in ) { #For each line of input
if ( /$start/i .. /$end/i ) { #Block matching
push #block, $_;
}
if ( /$end/i ) {
for ( #block ) {
if ( /\s+ $keyword/ ) {
print $out join( '', #block );
last;
}
}
#block = ();
}
close $in or die "Cannot close file '$input': $!";
}
close $out or die "Cannot close file '$output': $!";
But I got nothing after execution. Can anyone suggest me with sample idea?
Most everything looks good but it's your start regex that's causing the first problem:
'^\/begin CHECK\n\n'
You are reading lines from the file but then looking for two newlines in a row. That's not going to ever match because a line ends with exactly one newline (unless you change $/, but that's a different topic). If you want to match the send of a line, you can use the $ (or \z) anchor:
'^\/begin CHECK$'
Here's the program I pared down. You can adjust it to do all the rest of the stuff that you need to do:
use v5.10;
use strict;
use warnings;
use Data::Dumper;
my ($start, $keyword, $end) = (qr{^/begin CHECK$}, qr(^ADDRESS ), qr(^/end CHECK));
while (<DATA>) #For each line of input
{
state #block;
chomp;
if (/$start/i .. /$end/i) #Block matching
{
push #block, $_ unless /^\s*$/;
}
if( /$end/i )
{
print Dumper( \#block );
#block = ();
}
}
After that, you're not reading the data. You need to put the filehandle inside <> (the line input operator):
while ( <$in> )
The file handles will close themselves at the end of the program automatically. If you want to close them yourself that's fine but don't do that until you are done. Don't close $in until the while is finished.
using the command prompt in windows. In MacOS or Unix will follow the same logic you can do:
perl -wpe "$/='/end CHECK';s/^.*?(Var_\S+).*?(ADDRESS \S+).*$/$1 => $2\n/s" "your_file.txt">"new.txt
first we set the endLine character to $/ = "/end CHECK".
we then pick only the first Var_ and the first ADDRESS. while deleting everything else in single line mode ie Dot Matches line breaks \n. s/^.*?(Var_\S+).*?(ADDRESS \S+).*$/$1 => $2\n/s.
We then write the results into a new file. ie >newfile.
Ensure to use -w -p -e where -e is for executing the code, -p is for printing and -w is for warnings:
In this code, I did not write the values to a new file ie, did not include the >newfile.txt prt so that you may be able to see the result. If you do include the part, just open the newfile.txt and everything will be printed there
Here are some of the issues with your code
You have while ($in) instead of while ( <$in> ), so your program never reads from the input file
You close your input file handle inside the while read loop, so you can only ever read one record
Your $start regex pattern is '^\/begin CHECK\n\n'. The single quotes make your program search for backslash n backslash n instead of newline newline
Your test if (/\s+ $keyword/) looks for multiple space characters of any sort, followed by a space, followed by ADDRESS—the contents of $keyword. There are no occurrences of ADDRESS preceded by whitespace anywhere in your data
You have also written far too much without testing anything. You should start by writing your read loop on its own and make sure that the data is coming in correctly before proceeding by adding two or three lines of code at a time between tests. Writing 90% of the functionality before testing is a very bad approach.
In future, to help you address problems like this, I would point you to the excellent resources linked on the Stack Overflow Perl tag information page
The only slightly obscure thing here is that the range operator /$start/i .. /$end/i returns a useful value; I have copied it into $status. The first time the operator matches, the result will be 1; the second time 2 etc. The last time is different because it is a string that uses engineering notation like 9E0, so it still evaluates to the correct count but you can check for the last match using /E/. I've used == 1 and /E/ to avoid pushing the begin and end lines onto #block
I don't think there's anything else overly complex here that you can't find described in the Perl language reference
use strict;
use warnings;
use autodie; # Handle bad IO status automatically
use List::Util 'max';
my ($input, $output) = qw/ input.log output.txt /;
open my $in_fh, '<', $input;
my ( #block, #vars );
while ( <$in_fh> ) {
my $status = m{^/begin CHECK}i .. m{^/end CHECK}i;
if ( $status =~ /E/ ) { # End line
#block = grep /\S/, #block;
chomp #block;
my $var = $block[0];
my $addr;
for ( #block ) {
if ( /^ADDRESS\s+(0x\w+)/ ) {
$addr = $1;
last;
}
}
push #vars, [ $var, $addr ];
#block = ();
}
elsif ( $status ) {
push #block, $_ unless $status == 1;
}
}
# Format and generate the output
open my $out_fh, '>', $output;
my $w = max map { length $_->[0] } #vars;
printf $out_fh "%-*s => %s\n", $w, #$_ for [qw/ Name Address / ], #vars;
close $out_fh;
output
Name => Address
Var_AAA => 0xFF0011
Var_BBB => 0xFF0022
Update
For what it's worth, I would have written something like this. It produces the same output as above
use strict;
use warnings;
use autodie; # Handle bad IO status automatically
use List::Util 'max';
my ($input, $output) = qw/ input.log output.txt /;
my $data = do {
open my $in_fh, '<', $input;
local $/;
<$in_fh>;
};
my #vars;
while ( $data =~ m{^/begin CHECK$(.+?)^/end CHECK$}gms ) {
my $block = $1;
next unless $block =~ m{(\w+).+?ADDRESS\s+(0x\w+)}ms;
push #vars, [ $1, $2 ];
}
open my $out_fh, '>', $output;
my $w = max map { length $_->[0] } #vars;
printf $out_fh "%-*s => %s\n", $w, #$_ for [qw/ Name Address / ], #vars;
close $out_fh;

Perl print to seperate files

I have a text file which lists a service, device and a filter, here I list 3 examples only:
service1 device04 filter9
service2 device01 filter2
service2 device10 filter11
I have written a perl script that iterates through the file and should then print device=device filter=filter to a file named according to the service it belongs to, but if a string contains a duplicate filter, it should add the devices to the same file, seperated by semicolons. Looking at the above example, I then need a result of:
service1.txt
device=device04 filter=filter9
service2.txt
device=device01 filter=filter2 ; device=device10 filter=filter11
Here is my code:
use strict;
use warnings qw(all);
open INPUT, "<", "file.txt" or die $!;
my #Input = <INPUT>;
foreach my $item(#Input) {
my ($serv, $device, $filter) = split(/ /, $item);
chomp ($serv, $device, $filter);
push my #arr, "device==$device & filter==$filter";
open OUTPUT, ">>", "$serv.txt" or die $!;
print OUTPUT join(" ; ", #arr);
close OUTPUT;
}
The problem I am having is that both service1.txt and service2.txt are created, but my results are all wrong, see my current result:
service1.txt
device==device04 filter==filter9
service2.txt
device==device04 filter==filter9 ; device==device01 filter==filter2device==device04 filter==filter9 ; device==device01 filter==filter2 ; device==device10 filter==filter11
I apologise, I know this is something stupid, but it has been a really long night and my brain cannot function properly I believe.
For each service to have its own file where data for it accumulates you need to distinguish for each line what file to print it to.
Then open a new service-file when a service without one is encountered, feasible since there aren't so many as clarified in a comment. This can be organized by a hash service => filehandle.
use warnings;
use strict;
use feature 'say';
my $file = shift #ARGV || 'data.txt';
my %handle;
open my $fh, '<', $file or die "Can't open $file: $!";
while (<$fh>) {
my ($serv, $device, $filter) = split;
if (exists $handle{$serv}) {
print { $handle{$serv} } " ; device==$device & filter==$filter";
}
else {
open my $fh_out, '>', "$serv.txt" or do {
warn "Can't open $serv.txt: $!";
next;
};
print $fh_out "device==$device & filter==$filter";
$handle{$serv} = $fh_out;
}
}
say $_ '' for values %handle; # terminate the line in each file
close $_ for values %handle;
For clarity the code prints almost the same in both cases, what surely can be made cleaner. This was tested only with the provided sample data and produces the desired output.
Note that when a filehandle need be evaluated we need { }. See this post, for example.
Comments on the original code (addressed in the code above)
Use lexical filehandles (my $fh) instead of typeglobs (FH)
Don't read the whole file at once unless there is a specific reason for that
split has nice defaults, split ' ', $_, where ' ' splits on whitespace and discards leading and trailing space as well. (And then there is no need to chomp in this case.)
Another option is to first collect data for each service, just as OP attempts, but again use a hash (service => arrayref/string with data) and print at the end. But I don't see a reason to not print as you go, since you'd need the same logic to decide when ; need be added.
Your code looks pretty perl4-ish, but that's not a problem. As MrTux has pointed out, you are confusing collection and fanning out of your data. I have refactored this to use a hash as intermediate container with the service name as keys. Please note that this will not accumulate results across mutliple calls (as it uses ">" and not ">>").
use strict;
use warnings qw(all);
use File::Slurp qw/read_file/;
my #Input = read_file('file.txt', chomp => 1);
my %store = (); # Global container
# Capture
foreach my $item(#Input) {
my ($serv, $device, $filter) = split(/ /, $item);
push #{$store{$serv}}, "device==$device & filter==$filter";
}
# Write out for each service file
foreach my $k(keys %store) {
open(my $OUTPUT, ">", "$k.txt") or die $!;
print $OUTPUT join(" ; ", #{$store{$k}});
close( $OUTPUT );
}

Why does setting the Perl input record separator to $/="__Data__\n" not work?

Why does setting the Perl input record separator to $/ = "__Data__\n" not work?
The data record is set as follows:
__Data__\n
1aaaaaaaaaa\n
aaaaaaaaaaa\n
aaaaaaaaaaaaa\n
__Data__\n
1bbbbbbbbbb\n
bbbbbbbbbbb\n
bbbbbbbbbbbbb\n
__Data__\n
1cccccccccc\n
ccccccccccc\n
ccccccccccccc\n
__Data__\n
Here is the Perl code to access the first row of each data record...
$/ = "__Data__\n";
open READFILE, "<", "logA.txt" or die "Unable to open file";
while (<READFILE>)
{
if (/([^\n]*)\n(.*)/sm)
{
print "$1\n";
}
}
close(<READFILE>);
I get the undesirable output of:
__Data__
and not the desirable output of:
1aaaaaaaaaaa
1bbbbbbbbbbb
1ccccccccccc
Why is the input record separator $/="__Data__"; not working? How should it work?
If I understand the question correctly, you want to strip out the __Data__ part. You want this...
1aaaaaaaaaa
1bbbbbbbbbb
1cccccccccc
...but you're getting this...
__Data__
1aaaaaaaaaa
1bbbbbbbbbb
1cccccccccc
You can use the chomp command to remove the end of line. Normally this is just a newline, but chomp responds to whatever you set $/ to.
use strict;
use warnings;
{
local $/="__Data__\n";
open my $fh, "<", "logA.txt" or die "Unable to open file";
while(my $record = <$fh>) {
chomp $record;
print $record;
}
}
BTW because you changed the concept of "end of line", everything between the __Data__ fields will be considered a single line. If you need to split the lines up, you can use my #lines = split "\n", $record.
use strict;
use warnings;
{
# Isolate the change to the global $/
local $/="__Data__\n";
open my $fh, "<", "logA.txt" or die "Unable to open file";
while(my $record = <$fh>) {
# Remove the __Data__ separator
chomp $record;
# Split the record by line
my #lines = split /\n/, $record;
# Empty record, skip it
next if !#lines;
# Print the first line of the record
print $lines[0], "\n";
}
}
I also made some general improvements to your code. $/ is global and will affect everything that reads files. local ensures your change only happens inside the block.
I've used lexical filehandles, they automatically close themselves when they go out of scope (when the block they're declared in is done).
And I've turned on strict and warnings which will catch typos and little mistakes like close(<READLINE>).
input.txt
__Data__
1aaaaaaaaaa
aaaaaaaaaaa
aaaaaaaaaaaaa
__Data__
1bbbbbbbbbb
bbbbbbbbbbb
bbbbbbbbbbbbb
__Data__
1cccccccccc
ccccccccccc
ccccccccccccc
__Data__
using $/=qq{__Data__\n}
perl -e 'use Data::Dumper;$Data::Dumper::Useqq=1; $/=qq{__Data__\n}; open $fh,"input.txt"; print Dumper [ <$fh> ]'
$VAR1 = [
"__Data__\n",
"1aaaaaaaaaa\naaaaaaaaaaa\naaaaaaaaaaaaa\n__Data__\n",
"1bbbbbbbbbb\nbbbbbbbbbbb\nbbbbbbbbbbbbb\n__Data__\n",
"1cccccccccc\nccccccccccc\nccccccccccccc\n__Data__"
];
using $/=qq{Data}
$VAR1 = [
"__Data",
"__\n1aaaaaaaaaa\naaaaaaaaaaa\naaaaaaaaaaaaa\n__Data",
"__\n1bbbbbbbbbb\nbbbbbbbbbbb\nbbbbbbbbbbbbb\n__Data",
"__\n1cccccccccc\nccccccccccc\nccccccccccccc\n__Data",
"__"
];
I guess it's self explanatory.

perl equal strings returns 0 even if they are equal

Perl is continuing to surprise me. I have a code which takes an input from the command line and checks if it is in a file. I have a file like this:
ls
date
pwd
touch
rm
First i read this file as
open(MYDATA,"filename") or die "Can not open file\n";
#commandlist = <MYDATA>;
chomp #commandlist;
close MYDATA;
the argument is in $commandname variable. To check if it is correct i printed to screen.
print $commandname."\n";
it works well. then i write the code.
$count = #commandlist;
for($i=0;$i < $count;$i++)
{
print $commandname;
print $commandlist[$i];
print "\n";
if($commandname eq $commandlist[$i])
{
print "equal\n";
}
}
and it does not print 'equal'. but it should do becaues $commandname variable has the value 'ls' which is in the file. i also print the value of $commandname and $commandlist[$i] to see if "visibly" they are equal and i get the output:
ls
lsls
lsdate
lspwd
lstouch
lsrm
here i see that they got the same value but why never eq operator evaluates to zero.
Additionally to get this task done, I have tried various methods all of which come to be useless like making a hash from the array and using exists.
I am struggling for this seemingly easy problem for a day but i just dont get it.
Thanks in advance
EDIT:
when i change the above loop as below
$count = #commandlist;
for($i=0;$i < $count;$i++)
{
print $commandlist[$i];
print $commandname;
print "\n";
if($commandname eq $commandlist[$i])
{
print "equal\n";
}
}
I got an output like.
ls
ls
lste
lsd
lsuch
ls
it seems like for some reason it overwrites some characters.
EDIT:
my whole script is like:
#reading file code, i posted above
while(<>)
chomp($_);
$commandname = $_;
if($commandname eq "start"){
##something here
} elsif ($commandname eq "machines"){
##something here
} else {
$count = #commandlist;
for($i=0;$i < $count;$i++)
{
print $commandlist[$i];
print $commandname;
print "\n";
if($commandname eq $commandlist[$i])
{
print "equal\n";
}
}
}
A bit change in the code would result in what you are looking for, "chomp" the string from array before you put it for comparison. Here it is
chomp $commandlist[$i];
if($commandname eq $commandlist[$i])
{
print "equal\n";
}
EDIT: as per perldoc chomp when you are chomping a list you should parenthesis. So, in your case ... instead simply saying
chomp #commandlist
make it like
chomp(#commandlist)
FINAL EDIT: I tried this and worked fine. Give it a try
$commandname = $ARGV[0];
open(MYDATA,"chk.txt") or die "Can not open file\n";
#commandlist = <MYDATA>;
chomp(#commandlist);
close MYDATA;
print $commandname."\n";
$count = #commandlist;
print $commandname;
for($i=0;$i < $count;$i++)
{
print $commandlist[$i];
print "\n";
if($commandname eq $commandlist[$i])
{
print "equal\n";
}
}
The overwritting indicates the presence of a CR. The lines end with CR LF, but you only remove the LF with chomp. Change
while (<>) {
chomp($_)
to
while (<>) {
s/\s+\z//;
You might consider restructuring your code as:
my $path='filename';
my $match='ls';
part 1 - read the file
open(my $fh, '<', $path) or die "failed to open $path: $!";
my #commandlist=<$fh>;
chomp #commandlist;
# or you can combine these lines as:
# chomp(my #commandlist=<$fh>);
# because chomp operates on the array itself rather than making a copy.
close($fh);
or
use File::Slurp qw/ read_file /;
# see http://search.cpan.org/dist/File-Slurp/lib/File/Slurp.pm
my #commandlist=read_file($path); # result is pre-chomped!
part 2 - check for a match
foreach my $command (#commandlist) {
print "$match equals $command\n" if $match eq $command;
}
One important consideration is that each line in your file must contain only the command name and cannot begin or end with any spaces or tabs. To compensate for possible leading or trailing whitespace, try:
foreach my $command (#commandlist) {
$command=~s/^\s+|\s+$//g; # strip leading or trailing whitespace
print "$match equals $command\n" if $match eq $command;
}
And finally, always start your Perl script with a Perl developer's bestest friends:
use strict;
use warnings;
which will catch most (if not all) errors caused by sloppy programming practice. (We all suffer from this!)

How can I read from a Perl filehandle that is an array element?

I quickly jotted off a Perl script that would average a few files with just columns of numbers. It involves reading from an array of filehandles. Here is the script:
#!/usr/local/bin/perl
use strict;
use warnings;
use Symbol;
die "Usage: $0 file1 [file2 ...]\n" unless scalar(#ARGV);
my #fhs;
foreach(#ARGV){
my $fh = gensym;
open $fh, $_ or die "Unable to open \"$_\"";
push(#fhs, $fh);
}
while (scalar(#fhs)){
my ($result, $n, $a, $i) = (0,0,0,0);
while ($i <= $#fhs){
if ($a = <$fhs[$i]>){
$result += $a;
$n++;
$i++;
}
else{
$fhs[$i]->close;
splice(#fhs,$i,1);
}
}
if ($n){ print $result/$n . "\n"; }
}
This doesn't work. If I debug the script, after I initialize #fhs it looks like this:
DB<1> x #fhs
0 GLOB(0x10443d80)
-> *Symbol::GEN0
FileHandle({*Symbol::GEN0}) => fileno(6)
1 GLOB(0x10443e60)
-> *Symbol::GEN1
FileHandle({*Symbol::GEN1}) => fileno(7)
So far, so good. But it fails at the part where I try to read from the file:
DB<3> x $fhs[$i]
0 GLOB(0x10443d80)
-> *Symbol::GEN0
FileHandle({*Symbol::GEN0}) => fileno(6)
DB<4> x $a
0 'GLOB(0x10443d80)'
$a is filled with this string rather than something read from the glob. What have I done wrong?
You can only use a simple scalar variable inside <> to read from a filehandle. <$foo> works. <$foo[0]> does not read from a filehandle; it's actually equivalent to glob($foo[0]). You'll have to use the readline builtin, a temporary variable, or use IO::File and OO notation.
$text = readline($foo[0]);
# or
my $fh = $foo[0]; $text = <$fh>;
# or
$text = $foo[0]->getline; # If using IO::File
If you weren't deleting elements from the array inside the loop, you could easily use a temporary variable by changing your while loop to a foreach loop.
Personally, I think using gensym to create filehandles is an ugly hack. You should either use IO::File, or pass an undefined variable to open (which requires at least Perl 5.6.0, but that's almost 10 years old now). (Just say my $fh; instead of my $fh = gensym;, and Perl will automatically create a new filehandle and store it in $fh when you call open.)
If you are willing to use a bit of magic, you can do this very simply:
use strict;
use warnings;
die "Usage: $0 file1 [file2 ...]\n" unless #ARGV;
my $sum = 0;
# The current filehandle is aliased to ARGV
while (<>) {
$sum += $_;
}
continue {
# We have finished a file:
if( eof ARGV ) {
# $. is the current line number.
print $sum/$. , "\n" if $.;
$sum = 0;
# Closing ARGV resets $. because ARGV is
# implicitly reopened for the next file.
close ARGV;
}
}
Unless you are using a very old perl, the messing about with gensym is not necessary. IIRC, perl 5.6 and newer are happy with normal lexical handles: open my $fh, '<', 'foo';
I have trouble understanding your logic. Do you want to read several files, which just contains numbers (one number per line) and print its average?
use strict;
use warnings;
my #fh;
foreach my $f (#ARGV) {
open(my $fh, '<', $f) or die "Cannot open $f: $!";
push #fh, $fh;
}
foreach my $fh (#fh) {
my ($sum, $n) = (0, 0);
while (<$fh>) {
$sum += $_;
$n++;
}
print "$sum / $n: ", $sum / $n, "\n" if $n;
}
Seems like a for loop would work better for you, where you could actually use the standard read (iteration) operator.
for my $fh ( #fhs ) {
while ( defined( my $line = <$fh> )) {
# since we're reading integers we test for *defined*
# so we don't close the file on '0'
#...
}
close $fh;
}
It doesn't look like you want to shortcut the loop at all. Therefore, while seems to be the wrong loop idiom.