I need to know how to customize my own errors in Perl. For instance, here's some code:
my $filename = 'filaname1.exe';
print "Copying $filename";
copy("$dir_root\\$filename", "$spcl_dir\\$filename");
if ($? == "0") {
print " - Success!\n";
}
else { print " - Failure!\n"; }
I tried to write this and "catch" the error and print "Failure" when I don't get an exit code of 0, and print "Success" when I do. I need to know how I can customize this; I don't really want to use die or anything like that where it will give a somewhat cryptic error (to the end user).
Thanks!
You need to read the documentation on $? in perlvar. This value is:
The status returned by the last pipe
close, backtick ("``") command,
successful call to wait() or
waitpid(), or from the system()
operator.
Your call to copy (presumably from File::Copy) doesn't far into any of those categories, so $? isn't set.
However, if you read the documentation for File::Copy, you'll see that its function all "return 1 on success, 0 on failure". So you can simplify your code a lot.
#!/usr/bin/perl
use strict; use warnings;
use File::Copy;
if (copy('notthere', 'somewhere else')) {
warn "success\n";
} else {
warn "failure: $!\n";
}
Note that I've used "warn" rather than "print" so that the errors go to STDERR. Note, also, the use of $! to display the operating system error. This can, of course, be omitted if it's not user-friendly enough.
Are you using File::Copy? You must be using something, because copy() isn't a perl keyword or built-in function.
The documentation of File::Copy doesn't refer to $? at all, so that's probably your mistake. You want to check the return value, and only if it's zero, refer to $!.
use strict;
use File::Copy qw(copy);
my ($from, $to) = #ARGV;
my $res = copy ($from, $to);
if( $res ){
print "Okay\n";
}
else{
print "Not Okay: $!\n";
}
Related
A couple of times I've ran into the situation where I've forgotten to load the Try::Tiny module in my script and I've still used its try-catch block, like this:
#!/usr/bin/env perl
use strict;
use warnings;
try {
call_a( 'x' );
} catch {
die "ACTUALLY die $_";
};
sub call_a {
die "Yes, I will";
}
For some reason, the script works fine without giving any hints that there is no try. No Undefined subroutine errors. This makes me wonder why my raised exceptions are not caught.
Why does this work silently, without an error?
EDIT
I looked into symbol table as well:
say "$_: %main::{ $_ }" for keys %main::;
and found there no try. Also I tried to call it as main::try in the script above, and it caused also no errors.
This is due to the indirect-object syntax, and is a more elaborate variation on this example.
The "indirect object notation" allows code
PackageName->method(#args);
to be written as
method PackageName #args;
So the "try" and "catch" words don't matter. The interesting bit here is the more involved and extended syntax, with two parts, each in this indirect object notation.
The code in question in fact has method BLOCK LIST form, but that also goes by indirect object syntax into (do BLOCK)->method(LIST), where do BLOCK needs to produce a name of a package or a blessed (object) reference for a meaningful method call. This is seen below in Deparse output.
Using B::Deparse compiler backend (via O module) on this code
use strict;
use warnings;
use feature 'say';
try { call_a( 'x' ) }
catch {
die "ACTUALLY die";
#say "NO DONT die";
};
sub call_a {
die "Yes it dies";
#say "no die";
}
as perl -MO=Deparse script.pl should show a very close approximation of what runs:
use warnings;
use strict;
use feature 'say';
try {
call_a('x')
} do {
die 'ACTUALLY die'
}->catch;
sub call_a {
use warnings;
use strict;
use feature 'say';
die 'Yes it dies';
}
undef_sub.pl syntax OK
The nested indirect object syntax is apparently too much for Deparse which still leaves method BLOCK LIST form in the output. The equivalent code can be spelled out as
(do { call_a('x') })->try( (do { die("ACTUALLY die") })->catch() );
what in this case is more simply
call_a('x')->try( die("ACTUALLY die")->catch() );
Thus the original code is interpreted as valid syntax (!) and it is the contents of the block after try (call_a('x')) that runs first --- so the program dies and never gets to go for the "method" try.
It gets more interesting if we change the example to
use strict;
use warnings;
use feature 'say';
try { call_a( 'x' ) }
catch {
#die "ACTUALLY die";
say "NO DONT die";
};
sub call_a {
#die "Yes it dies";
say "no die";
}
with no die-ing anywhere. Run it with -MO=Deparse to see
use warnings;
use strict;
use feature 'say';
try {
call_a('x')
} (catch {
say 'NO DONT die'
} );
sub call_a {
use warnings;
use strict;
use feature 'say';
say 'no die';
}
undef_sub.pl syntax OK
which is now in a straight-up method {} args syntax (with args itself shown by Deparse in an indirect object notation as well).
The equivalent code is
call_a('x')->try( say("NO DONT die")->catch() );
where first the call_a() goes and, after it returns, then the code for the argument list in the try method call runs next. We aren't running into a die and an actual run goes as
no die
NO DONT die
Can't call method "catch" without a package or object reference at ...
So now a problem with the method "catch" does come up.
Thanks to ikegami for comments
If the block above were to return a name of a package (or object reference) which does have a method catch then the try would finally be attempted as well
use strict;
use warnings;
use feature 'say';
BEGIN {
package Catch;
sub catch { say "In ", (caller(0))[3] };
$INC{"Catch.pm"} = 1;
};
use Catch;
try { call_a( 'x' ) }
catch {
say "NO DONT die";
"Catch";
};
sub call_a { say "no die" }
Now we have the equivalent
call_a('x')->try( do { say("NO DONT die"); 'Catch' }->catch() );
with the output
no die
NO DONT die
In Catch::catch
Can't call method "try" without a package or object reference at undef_sub.pl line 14.
#!/bin/perl
open( $WP, ">/home/Octa.txt" );
# Subroutine test
sub test {
$var1 = shift;
print $WP "TESTING\n";
}
# Subroutine func
sub func {
$var = shift;
if ( $var eq "Ocat" ) {
print $WP "String found\n";
test($var);
}
else {
print $WP "String not found\n";
}
}
$var3 = "Octa";
func($var3);
The issue is that the code is not able to write anything within the test subroutine or within the if condition of the 'funcsubroutine, but it prints in theelse` part of the 'func' subroutine.
First off, there is a typo -- you test $var against "Ocat", while Octa is intended.
So the test subroutine never gets called and only String not found is printed.
With that corrected and with the output file in a user writeable location, your program works.
However, some improvements are necessary.
use warnings;
use strict;
my $file = 'Octa.txt';
open my $WP, '>', $file or die "Can't open $file: $!";
my $var3 = "Octa";
func($WP, $var3);
#Subroutine test
sub test{
my ($fh, $var1) = #_;
print $fh "TESTING\n";
}
#Subroutine func
sub func{
my ($fh, $var) = #_;
if ($var eq "Octa"){
print $fh "String found\n";
test($fh, $var);
}
else {
print $fh "String not found\n";
}
}
I've changed the output file name since a user normally may not write to /home directory.
Comments
It is much better to use the three-argument form of open, in which case you get a lexical file handle which can be passed around nicely and is scoped. This question is a good example of how a global file handle can make things confusing, to say the least.
Always check the open call. For one thing, can you really write to /home directory?
Please always start programs with use warnings; and use strict;
There is another possibility for failure, which brings together practices in the comments above.
A file in /home normally isn't writeable by a user, in which case the posted program cannot work.
But without a check of open (which will fail) and without use warnings (which would be printed every time we touch the invalid $WH filehandle) we will not see any of these errors; instead, the program will quietly run and complete but it won't write the output file.
I know that in java language ,if an exception is catched successfully ,the code after the try-catch-clause will still run.In perl ,it uses eval to catch exception.So ,I write two simple programs to test it.
testEval1.pl:
$exp = '$i = 3; die "error message"; $k = $i + $j';
push ( #program, '$i = 3; die "error message"; $k = $i + $j');
$rtn =eval($exp);
if ( ! defined ( $rtn))
{
print "Exception: " , $#,"\n";
}
else
{
print $rtn,"\n";
}
output of testEval1.pl:
code continue to run after die!
Exception: error message at (eval 1) line 1.
testEval2.pl
$baseDir = "/home/wuchang/newStore1";
my $eval_rtn = eval(opendir(BASEDIR,$baseDir) or die "dir doesn't exist!\n");
print "code continue to run after die!\n";
if(!defined($eval_rtn)){
print $#;
}
else
{
print $rtn,"\n";
}
output of testEval2.pl:
dir doesn't exist!
you can see that in the two code examples , the code block of eval both has die expressions.But in testEval1.pl,the code after eval can be excuted,while in testEval2.pl,it's not!
So ,my question is ,what's the difference ?
What can I do to make the program continue to run even if a "dir doesn't exist" exception happeded ?
thank you.
You're evaling result of
opendir(BASEDIR,$baseDir) or die "dir doesn't exist!\n"
code. If it would succeed that would be equivalent of eval(1).
What you want is eval BLOCK:
my $eval_rtn = eval{ opendir(BASEDIR,$baseDir) or die "dir doesn't exist!\n" };
Check perldoc -f eval for difference between eval EXPR and eval BLOCK
To answer your question title:
Will code after eval(die “some error message”) continue to be executed?
The answer is "No". But please read on, because this is not a problem, but a misunderstanding about the Perl syntax involved.
The line:
my $eval_rtn = eval( opendir(BASEDIR,$baseDir) or die "dir doesn't exist!\n" );
Does not get as far as running the eval. The syntax you have used with (..) brackets takes a scalar value, and before the eval does anything at all, it is waiting for the opendir...or die expression to return a string (which will then be evaluated). To make it equivalent to your other example, you could make the param a string:
my $eval_rtn = eval( q{opendir(BASEDIR,$baseDir) or die "dir doesn't exist!\n"} );
You could also use the block form instead:
my $eval_rtn = eval { opendir(BASEDIR,$baseDir) or die "dir doesn't exist!\n"; };
I would recommend using the block form where possible, it is usually easier to debug, and in your case better matches the exception handling semantics that you want to achieve.
[EDIT] - with the benefit of hindsight, this question was misdirected. I have not deleted it because it is a good example of the incorrect use of eval and correct criticism by Perl::Critic.
Perl Critic raises the following criticism for the code below:
Return value of eval not tested. You can't depend upon the value of $#/$EVAL_ERROR to tell whether an eval failed
my $Jet = Win32::OLE->CreateObject('DAO.DBEngine.36')
or croak "Can't create Jet database engine.";
my $DB = $Jet->OpenDatabase($DBFile)
# code omitted for the sake of brevity
# perl script writes results to Access db via an append query
$DB->Execute( $SQLquery, 128 ); #128=DBFailOnError
eval {$err = Win32::OLE->LastError()} ; #<<<< PROBLEM LINE SEE FEEDBACK BELOW
if ( $err){
print $ERROR "WIN32::OLE raised an exception: $err\n";
Win32::OLE->LastError(0); # this clears your error
}
My thinking is that I am using eval to detect the existence of the error object and on the Win32:OLE module to detects the error and reports it.
Am I safe to ignore the criticism?
Leaving aside the perl-critic issuse, your code does not make much sense.
The Win32::OLE docs explain when exceptions will be thrown (and how you can automatically catch them).
LastError just gives you information about an error after it has occurred assuming your program has not died. Wrapping it in eval is pointless.
Update: I would have written something along the following lines (untested because I am on Linux with no access to Windows right now):
use strict;
use warnings;
use Carp;
use Win32;
use Win32::OLE;
$Win32::OLE::Warn = 3;
# No need for this eval if you are OK with the default error message
my $Jet = eval {
Win32::OLE->CreateObject('DAO.DBEngine.36')
} or croak sprintf(
"Can't create Jet database engine: %s",
win32_error_message(Win32::OLE->LastError)
);
# No need for this eval if you are OK with the default error message
my $DB = eval {
$Jet->OpenDatabase($DBFile)
} or croak sprintf(
"Can't open database '$DBFile': %s",
win32_error_message(Win32::OLE->LastError)
);
my $result = eval {
$DB->Execute( $SQLquery, 128 )
};
unless (defined $result) {
print $ERROR win32_error_message(Win32::OLE->LastError);
Win32::OLE->LastError(0);
}
The meaning of that message is detailed in the documentation. In short, it tells you to not rely on $# alone after an eval, but to also check the return value of eval.
However, in your case, the problem is that you aren't checking either the return value of eval nor are you checking $# and moreover it seems that your use of eval is completely superfluous because the method you are calling shouldn't be throwing any exceptions.
I'm trying to use Test::More to unit test Perl functions that print to the screen.
I understand that this output may interfere with tools such as prove.
How can I capture this output so I can print it with diag(), and also run tests on the output itself?
UPDATE: IMHO, the correct answer to this question ought to be to use Test::Output:
#!/usr/bin/perl
use strict; use warnings;
use Test::More tests => 1;
use Test::Output;
sub myfunc { print "This is a test\n" }
stdout_is(\&myfunc, "This is a test\n", 'myfunc() returns test output');
Output:
C:\Temp> tm
1..1
ok 1 - myfunc() returns test output
I am leaving the original answer for reference as, I believe, it still illustrates a useful technique.
You can localize STDOUT and reopen to a scalar before calling the function, restore afterward:
#!/usr/bin/perl
use strict; use warnings;
use Test::More tests => 1;
sub myfunc { print "This is a test\n" }
sub invoke {
my $sub = shift;
my $stdout;
{
local *STDOUT;
open STDOUT, '>', \$stdout
or die "Cannot open STDOUT to a scalar: $!";
$sub->(#_);
close STDOUT
or die "Cannot close redirected STDOUT: $!";
}
return $stdout;
}
chomp(my $ret = invoke(\&myfunc));
ok($ret eq "This is a test", "myfunc() prints test string" );
diag("myfunc() printed '$ret'");
Output:
C:\Temp> tm
1..1
ok 1 - myfunc() prints test string
# myfunc() printed 'This is a test'
For versions of perl older than 5.8, you probably need to use IO::Scalar, but I do not know much about how things worked before 5.8.
I'd look at letting a module handle this for you. Look at Capture::Tiny.
If this is code that you are writing yourself, change it so that the print statements don't use a default filehandle. Instead, give yourself a way to set the output filehandle to anything you like:
sub my_print {
my $self = shift;
my $fh = $self->_get_output_fh;
print { $fh } #_;
}
sub _get_output_fh { $_[0]->{_output} || \*STDOUT }
sub _set_output_fh { $_[0]->{_output} = $_[1] } # add validation yourself
When you test, you can call _set_output_fh to give it your testing filehandle (perhaps even an IO::Null handle). When another person wants to use your code but capture the output, they don't have to bend over backward to do it because they can supply their own filehandle.
When you find a part of your code that is hard to test or that you have to jump through hoops to work with, you probably have a bad design. I'm still amazed at how testing code makes these things apparent, because I often wouldn't think about them. If it's hard to test, make it easy to test. You generally win if you do that.