I don't understand why the following:
my $err = undef;
while(1){
if($err && ($err->code == 502)) {
[...]
}
[...]
eval {...}
$err = $#;
}
results in Can't call method "code" on an undefined value at ./filename.pl line 74. in perl v5.8.8.
In other words: why does perl execute the second boolean expresion, even if the OP1 && OP2 construct cannot become true because the first operand is false (undef).
even the more verbose version if( (defined $err) && ($err->code == 502)) produces the same result.
Thanks in advance :)
For information, when I run your code as follows on a Perl 5.10.1 interpreter, I get no error message at all. (This is really more a comment than an answer, only it does not fit in the comment column. It needs no upvote.)
#!/usr/bin/perl
use warnings;
use strict;
use integer;
my $err = undef;
while(1){
if($err && ($err->code == 502)) {
warn;
}
eval {1};
$err = $#;
}
If it is undef as you say, that version of Perl or your build of perl is buggy if you get that behaviour from that code. Neither is likely.
But it might not be undef. Keep in mind that the error might not come from the first pass of the loop. $err might contain an object with buggy overloaded operators (e.g. inconsistent boolean and stringification overloads). What does the following show?
use Devel::Peek;
Dump($err);
The reason why $err ($#) was obviously not undef after the eval{} was that a spawned function within the eval returned an error beacause of its disability to read from a file which wasn't caught by the sourrounding code :(
Thanks #ikegami for the suggestion, I got the trace using Dump after all.
The solution for the problem therefore is outside of the democode, sorry for that. I just had to create the file...
Related
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";
}
This is a continuation of my previous question:
In Perl, how can I check for the existence of Socket options without generating warnings?
If I run the following code I get the result I expect:
#!/usr/bin/perl -w
use strict;
use diagnostics;
use Socket qw(:all);
my %opts;
if ( defined( eval { SO_REUSEPORT } ) ) {
$opts{'SO_REUSEPORT'}
= {opt_level =>SOL_SOCKET,opt_name=>SO_REUSEPORT,opt_print=>\&sock_str_flag};
} else {
print "SO_REUSEPORT undefined\n";
$opts{'SO_REUSEPORT'}
= {opt_level =>0,opt_name=>0,opt_print=>undef};
}
=head
# IPV6 options
if ( defined( eval { IPV6_DONTFRAG } ) ) {
$opts{'IPV6_DONTFRAG'}
= {opt_level =>IPPROTO_IPV6,opt_name=>IPV6_DONTFRAG,opt_print=>\&sock_str_flag};
} else {
print "IPV6_DONTFRAG undefined\n";
$opts{'IPV6_DONTFRAG'}
= {opt_level =>0,opt_name=>0,opt_print=>undef};
}
=cut
It outputs:
anon#perl$ ./test.pl
SO_REUSEPORT undefined
But if I uncomment the block for IPV6_DONTFRAG I get:
Bareword "IPV6_DONTFRAG" not allowed while "strict subs" in use at ./test.pl line 17.
Bareword "IPV6_DONTFRAG" not allowed while "strict subs" in use at ./test.pl line 17.
Why is one undefined bareword causing it to barf and the other not? And how can the error be propagating out of the eval { } block?
Edit
Apparently, SO_REUSEPORT is exported by Socket.pm in some manner as it's in the #EXPORT array. So apparently it's defined but using it throws an error which the eval catches.
That still doesn't explain what's going on with IPV6_DONTFRAG. I suppose I would need to define it myself and then just call getsockopt to check if it's supported...
I recommend writing it this way:
if ( defined( &IPV6_DONTFRAG ) ) {
$opts{'IPV6_DONTFRAG'}
= {opt_level =>IPPROTO_IPV6,opt_name=>&IPV6_DONTFRAG,opt_print=>\&sock_str_flag};
} else {
print "IPV6_DONTFRAG undefined\n";
$opts{'IPV6_DONTFRAG'}
= {opt_level =>0,opt_name=>0,opt_print=>undef};
}
Note the added ampersand in the value for opt_name, which evades constraints due to strict 'subs'.
The documentation for defined explains:
You may also use defined(&func) to check whether subroutine &func has ever been defined. The return value is unaffected by any forward declarations of &func. Note that a subroutine which is not defined may still be callable: its package may have an AUTOLOAD method that makes it spring into existence the first time that it is called—see perlsub.
For example, with SO_BROADCAST
if (defined &SO_BROADCAST) {
print "SO_BROADCAST = ", SO_BROADCAST, "\n";
}
the output on my machine is
SO_BROADCAST = 6
With regards to the IPV6_DONTFRAG bareword issue, it looks like Perl checks for barewords at compile time, not run time, as documented here. Eval is a construct to swallow runtime errors, so it won't help you here. It's like trying to handle a syntax error in C++ by sticking the offending code in a try/catch block.
[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 would expect the block in the second 'if' statement to be entered because of the undef value but the logs show that it isn't being entered.
sub getcmd{
my $self = $_[0];
if ( $self->_recv == OK ){
push #{$self->{'log'}}, ['NOTICE', "OK"];
return "My command";
}
push #{$self->{'log'}}, ['ERROR', "Did not get OK back"];
return undef;
}
...
if (!($ret = $self->getcmd)){
push #{$self->{'log'}}, ['ERROR', "failed to read after asking for NEXT"];
}
else {
push #{$self->{'log'}}, ['ERROR', "'undef' not detected in next()"];
}
The log file shows:
[Fri May 8 19:25:56 2009]: ERROR: Did not get OK back
[Fri May 8 19:26:02 2009]: ERROR: 'undef' not detected in next()
Any ideas gratefully accepted.
Edit: Sorry, I'd edited down the code to show the basic flow. I should've proofread it a bit better.
I added the $ret in getcmd() to simulate what happens in the logging function which just prints out the current value of $ret which is a global variable always used to capture return values.
I'd trimmed down the log messages and missed the extra "back"
Thanks for the suggestions and comments. I hadn't noticed the six second difference in the log timestamps so now I suspect that you're right about the execution sequence being different to what I originally expected.
I'll go back and look again. Guess that's what you get when trying to look at someone else's "average" Perl after a thirteen hour day trying to get things finished for a "must go live on Monday" project!
I didn't write the code and simply inherited it. The code was written by a couple of people who think they don't "need no steenking warnings or stricts".
Imagine 800 lines of Perl and lots of 'ifs' but no else statements! No defensive coding at all! 8-O
Reduced to a bare minimum, this prints "undef detected".
#!/bin/perl -w
use strict;
sub getcmd
{
return undef;
}
my $ret;
if (!($ret = getcmd()))
{
print "undef detected\n";
}
else
{
print "undef undetected\n";
}
Consequently, your problem is most likely that the $self->getcmd() isn't returning undef, even though you think it should.
I think something more complicated is going on here -- those log messages seem to be 6 seconds apart, and there's no way it'd take 6 seconds for the push statement, the return, and the if check.
Any chance the first log message was from a previous call of the method from some other place in the application?
Use perl debugger (perl -d) to step through the code to see what is going on. When debugging code, it's important to free your mind from every assumption.
Also, these lines are a must above every perl program:
use strict;
use warnings;
The proper way to test $var for undef is not if (!$var) ..., because the test will also be true for $var = '' and $var = 0.
Use if (!defined $var) ... instead.
Maybe like this (showing all relevant cases):
if (!defined $var) {
# not defined ...
} elsif ($var) {
# defined and true...
} else {
# defined and false
}
I'm working on a test framework in Perl. As part of the tests, I may need to add precondition or postcondition checks for any given test, but not necessarily for all of them. What I've got so far is something like:
eval "&verify_precondition_TEST$n";
print $# if $#;
Unfortunately, this outputs "Undefined subroutine &verify_precondition_TEST1 called at ..." if the function does not exist.
How can I determine ahead of time whether the function exists, before trying to call it?
Package::Name->can('function')
or
*Package::Name::function{CODE}
# or no strict; *{ "Package::Name::$function" }{CODE}
or just live with the exception. If you call the function in an eval and $# is set, then you can't call the function.
Finally, it sounds like you may want Test::Class instead of writing this yourself.
Edit: defined &function_name (or the no strict; defined &{ $function_name } variant), as mentioned in the other answers, looks to be the best way. UNIVERSAL::can is best for something you're going to call as a method (stylistically), and why bother messing around with the symbol table when Perl gives you syntax to do what you want.
Learning++ :)
sub function_exists {
no strict 'refs';
my $funcname = shift;
return \&{$funcname} if defined &{$funcname};
return;
}
if (my $subref = function_exists("verify_precondition_TEST$n") {
...
}
With defined:
if (eval "defined(&verify_precondition_TEST$n)") {
eval "&verify_precondition_TEST$n";
print $# if $#;
}
else {
print "verify_precondition_TEST$n does not exist\n";
}
EDIT: hmm, I only thought of eval as it was in the question but with symbolic references brought up with Leon Timmermans, couldn't you do
if (defined(&{"verify_precondition_TEST$n"}) {
&{"verify_precondition_TEST$n"};
print $# if $#;
}
else {
print "verify_precondition_TEST$n does not exist\n";
}
even with strict?
I had used Leon's approach, but when I had multiple packages, it failed. I'm not sure precisely why; I think it relates to the propagation of scope between namespaces. This is the solution I came up with.
my %symbols = ();
my $package = __PACKAGE__; # bring it in at run-time
{
no strict;
%symbols = %{$package . "::"}; #S ee Symbol Tables on perlmod
}
print "$funcname not defined\n" if (!defined($symbols{$funcname});
References:
__PACKAGE__ reference on the perlmod page.
Packages/__PACKAGE__reference on Perl Training Australia.