perl "or" error handling: multi-statement on error possible? - perl

This construct is pretty common in perl:
opendir (B,"/somedir") or die "couldn't open dir!";
But this does not seem to work:
opendir ( B, "/does-not-exist " ) or {
print "sorry, that directory doesn't exist.\n";
print "now I eat fugu.\n";
exit 1;
};
Is it possible for the "or" error-handling to have more than one command?
Compiling the above:
# perl -c test.pl
syntax error at test.pl line 5, near "print"
syntax error at test.pl line 7, near "}"
test.pl had compilation errors.

You can always use do:
opendir ( B, "/does-not-exist " ) or do {
print "sorry, that directory doesn't exist.\n";
print "now I eat fugu.\n";
exit 1;
}
Or you can use if/unless:
unless (opendir ( B, "/does-not-exist " )) {
print "sorry, that directory doesn't exist.\n";
print "now I eat fugu.\n";
exit 1;
}
Or you can swing together your own subroutine:
opendir ( B, "/does-not-exist " ) or fugu();
sub fugu {
print "sorry, that directory doesn't exist.\n";
print "now I eat fugu.\n";
exit 1;
}
There is more than one way to do it.

Exception handling in Perl is done with eval()
eval {
...
} or do {
...Use $# to handle the error...
};

Related

Perl counter print list with commas except last item

I am encountering an issue while trying to execute a perl script that takes 2 number arguments, well say $ARGV[0] is 2, and $ARGV[1] is 4. I need to print a list that shows 2,3,4 with no comma after the last item. Below is my script as it is now:
unless ((#ARGV)==2){
print "error: incorrect number of arguments",
"\n",
"usage: inlist.pl a b (where a < b)",
"\n";
exit VALUE;
}
if ($ARGV[0] > $ARGV[1]){
print "error: first argument must be less than second argument",
"\n",
"usage: intlist.pl a b (where a < b)",
"\n";
exit VALUE;
}
else {
$COUNTER=$ARGV[0];
while($COUNTER <= $ARGV[1]){
print $COUNTER;
$COUNTER += 1;
if ($COUNTERELATIONAL < $ARGV[1]){
print ", ";
}
else {
print "\n";
}
$COUNTERSYNTAX
}
}
exit VALUE;
I tried using join but to no avail I keep getting as return of 2,3,4,
I feel like i must be missing something simple
Rewriting your code to simplify it:
# Prefer 'if' over 'unless' in most circumstances.
if (#ARGV != 2) {
# Consider using 'die' instead of 'print' and 'exit'.
print "error: incorrect number of arguments\n",
"usage: inlist.pl a b (where a < b)\n";
# Not sure what VALUE is, but I assume you've
# defined it somewhere.
exit VALUE;
}
if ($ARGV[0] > $ARGV[1]) {
# Consider using 'die' instead of 'print' and 'exit'.
print "error: first argument must be less than second argument\n",
"usage: intlist.pl a b (where a < b)\n";
exit VALUE;
}
# Removed 'else' branch as it's unnecessary.
# Use 'join' instead of a complicated loop.
print join(',', $ARGV[0] .. $ARGV[1]), "\n";
# This looks like a successful execution to me, so
# that should probably be 'exit 0'.
exit VALUE;
If I was writing it for myself, I'd make it a little shorter:
my %errors = (
NUMBER => 'incorrect number of arguments',
RANGE => 'first argument must be less than second argument',
);
my $usage = 'usage: inlist.pl a b (where a < b)';
die "$errors{NUMBER}\n$usage\n" if #ARGV != 2;
die "$errors{RANGE}\n$usage\n" if $ARGV[0] > $ARGV[1];
print join(',', $ARGV[0] .. $ARGV[1]), "\n";
exit 0;
I figured it out:
while($COUNTER <= $ARGV[1]){
print $COUNTER;
$COUNTER += 1;
if ($COUNTER <= $ARGV[1]){
print ", ";
}
else {
print "\n";
}
I needed to change the if to $COUNTER and <= and it printed correctly. Thank you for the join suggestion, that would have worked if I had designed the script more efficiently

Exit Codes when using die in Perl

I have overridden die in perl for my logging framework, so that it can log messages and print it on console.
Overridden code for die:
BEGIN{ *CORE::GLOBAL::die = sub {
my ($package, $filename, $line, $subroutine) = caller;
untie *STDERR;
my $message;
foreach my $arg (#_) {
$message = $message.$arg;
}
print STDERR $message;
tie *STDERR, __PACKAGE__, (*STDERR);
logmessage("die",$message,$filename, $line);
#What exit code to pass?
#exit CODE;
}
}
I don't know what exit code to set while exiting the process as the normal die exits with an error code.
Is there any way I can find out what exit code to set when die is
called?
Also It would be helpful if can know the list of error codes availabe
in perl?
The exit code is documented in die:
exit $! if $!; # errno
exit $? >> 8 if $? >> 8; # child exit status
exit 255; # last resort
But as #amon noted, die doesn't exit, it throws an exception. Instead of overriding it, it might be clearer to wrap the whole thing into an eval { ... ; 1 } (or Try::Tiny's try) and log the exception in the or do or catch part.
die() exits with a none-zero exit code (but it's not defined, which, I believe):
jan#jancooltek ~ $ perl
die("test");
test at - line 1.
jan#jancooltek ~ $ echo $?
9
However, with -e:
jan#jancooltek ~ $ perl -e 'die("test")'
test at -e line 1.
jan#jancooltek ~ $ echo $?
255
exit() can use any exit code you'd like, there are no specific rules in Perl.
Settle on something != 0 and use that for these generic errors.

Perl compile time errors depending on the procedural order of subroutines

So I have this file:
casper_mint#casper-mint-dell ~/learn_perl_hard_way $ cat bettypage
foo foo foo foo foo foo foo
boo boo boo
And wanted to read it it and print it between 2 sub routines.
This kept throwing errors:
#!/usr/bin/perl
use strict;
use warnings ;
sub read_file {
my $file = shift ;
open (FILE, $file) || die " Couldn't open $file";
while (my $line = <FILE>) {
read_line $line ;
}
}
sub read_line {
my #list = split " ", shift ;
foreach my $word (#list) {
print "$word\n";
}
}
read_file(#ARGV) ;
casper_mint#casper-mint-dell ~/learn_perl_hard_way $ ./test_hash.pl bettypage
Can't locate object method "read_line" via package "foo foo foo foo foo foo foo" (perhaps you forgot to load "foo foo foo foo foo foo foo"?) at ./test_hash.pl line 13, <FILE> line 1.
casper_mint#casper-mint-dell ~/learn_perl_hard_way $
So I put the "read_line subroutine" before the "read_file subroutine" - since it depends on it, from a procedural point of view and it works just fine.
#!/usr/bin/perl
use strict;
use warnings ;
sub read_line {
my #list = split " ", shift ;
foreach my $word (#list) {
print "$word\n";
}
}
sub read_file {
my $file = shift ;
open (FILE, $file) || die " Couldn't open $file";
while (my $line = <FILE>) {
read_line $line ;
}
}
read_file(#ARGV) ;
I know from working with bash that the subroutines usually has to come first in the code for it to work.
However, I thought that perl compiles the script and then executes it. And by compiling, I did not think that it would matter where the subroutine was located.
That by compiling everything before executing the subroutine would at least be available to be read it by the whole program. If perl compiles the whole script before executing it, why should the order of the subroutine matter - shouldn't the "read_line" subroutine be available to the "read_file" subroutine - regardless of where it is placed in the script?
Unless predeclared, you need to call your subs with parenthesis, ie. read_line($line)
From perlsub
To call subroutines:
1. NAME(LIST); # & is optional with parentheses.
2. NAME LIST; # Parentheses optional if predeclared/imported.
3. &NAME(LIST); # Circumvent prototypes.
4. &NAME; # Makes current #_ visible to called subroutine.
But really, just get into the habit of always using parenthesis (option 1). Your code will thank you later with better readability and less surprises.

An alternative to block eval?

Is there an equivalent of the following -
eval { die "reason 1"; }; warn $# if $#;
eval { die "reason 2"; }; warn $# if $#;
eval { die "reason 3"; }; warn $# if $#;
.
.
As you can notice, the following code wont print out every possible reasons for the script to die..
eval {
die "reason 1";
die "reason 2";
die "reason 3";
};
warn $# if $#;
[EDIT] I would like to know all possible reasons the script (that uses lot many libraries) can fail. The die statements are not in a place i can edit.
overriding die is not exactly an alternative to eval, but this is what I think you're asking about, trapping die and turning it into a warn, log die and resume/continue program
$ perl -e " eval{die 1;}; die 2; die 3; "
2 at -e line 1.
$ perl -Mwarnerous -e " eval{die 1;}; die 2; die 3; "
FAKE die : 2 at -e line 1
FAKE die : 3 at -e line 1
$ cat warnerous.pm
*CORE::GLOBAL::die = sub {
unless( $^S ){
warn( qq{FAKE die : #_ #{[sprintf q{at %s line %s },(caller)[1,2] ]}\n} );
}
};
1;
Do you mean something like this?
my $problems;
for my $r (1 .. 3) {
eval { die "reason $r"; 1 } or $problems .= $#;
}
warn "There were the following problems:\n$problems";

problem while capturing the error of `make`

The purpose behind this perl script is to first refactor a .cpp file and then compile the whole package. If all goes well then move on to the next file otherwise replace the original file from the backup directory, and so on. Following is the perl script for running the makefile of a package.
#lcpp = `ls *.cpp`;
chomp(#lcpp);
foreach (#lcpp) {
print "processing file $_ ...";
`cp demac_dir/$_ .`;
if(2 == `make`) {
print "\n\t\t\tError in the file\n";
`cp backup/$_ .`;
print "reverting back to the original file and building the package again";
`make`;
}
else {#when successfully compiled
print "successfully compiled the package with file $_";
}
}
The script runs until i get a 'refactored' file with compiler errors. The script is unable to capture the error returned by make i guess. Or am i missing something.
Almost for sure make errors go to STDERR, which is not captured by backticks. Use Capture::Tiny for easy capture of both output streams.
If you use system() to invoke make, you can check whether make succeeded. see perldoc -f system:
#args = ("command", "arg1", "arg2");
system(#args) == 0
or die "system #args failed: $?"
You can check all the failure possibilities by inspecting $?
like this:
if ($? == -1) {
print "failed to execute: $!\n";
}
elsif ($? & 127) {
printf "child died with signal %d, %s coredump\n",
($? & 127), ($? & 128) ? 'with' : 'without';
}
else {
printf "child exited with value %d\n", $? >> 8;
}