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
}
Related
I want to replace existing print STDERR statements in my codebase.
Apparently, I find them not very suitable to eyes, or is it just me. Should I be using warn knowing that It will be caught by $SIG{_WARN_} handler. Or is there any better option. And if yes, why use those options and not print STDERR.
The benefit of print STDERR is that you can see at once what will happen—you print something to STDERR. This may be a debug message, or something.
The warn function is slightly different:
It will trigger the warn handlers, and
it will append the line number, if you don't end with a newline.
You should probably use this for warnings, not for logging data
You might be also interested in the Carp family of functions. carp works like warn, but reports the line number/file from the point of call. cluck will warn with a stack trace.
But nothing prevents you from rolling your own. A functionally equivalent sub to print STDERR would be:
sub debug { print STDERR #_ }
You can now literally s/print STDERR/debug/g your source, except for that one occurence. Also, you will have to declare or import that debug function before you use it if you want to be able to leave out the parens around the arguments.
debug "this ", "is ", "DATA";
Point to consider: calling a sub is slooow, whereas print is a built-in opcode. You can trade beauty for performance, and vice versa.
Creating a debug subroutine to wrap print STDERR would give you a lot of flexibility above and beyond what simple print or warn statements provide, such as the ability to turn debugging messages off or redirect them to different destinations. For example, just off the top of my head:
sub debug {
my ($msg, %param) = #_;
$param{level} //= 1; # default if no level specified
return if $param{level} < $config{log_level};
given ($param{dest}) {
when ('mail') { send_email_to_admin(subject => "Application Error!", body => $msg) }
when ('log') { write_to_logfile($msg) }
default { print STDERR $msg }
}
}
debug('foo'); # goes to STDERR by default
$config{log_level} = 2;
debug('bar'); # message is ignored as unimportant at current logging level
debug('bar', level => 3, dest => mail); # still important; gets emailed to admin
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...
Is there a way in Perl to declare that a method can throw an error (or die)?
EDIT: What interests me the most is a way to get the compiler or IDE to tell me I have an unchecked exception somewhere in my code.
I always loved how in Java, a method could handle an Exception and/or throw it. The method signature allows to put "throws MyException", so a good IDE/compiler would know that if you use said method somewhere in your code, you'd have to check for the Exception or declare your function to "throws" the Exception further.
I'm unable to find something alike in Perl. A collegue of mine wrote a method which "dies" on incorrect input, but I forget to eval-if($#) it... offcourse the error was only discovered while a user was running the application.
(offcourse I doubt if there is any existing IDE that could find these kind of things for Perl, but atleast perl -cw should be able to, no?)
Two potential answers. Pick whichever you like better:
In Perl, this is indicated by the module's POD. There's no way of marking it programmatically, so you need to rely on the documentation instead.
Any method can die, or at least any nontrivial method. It's going to call something else, which probably calls something else, etc., so the only way to guarantee that no exception will be thrown is to trace down through all the levels of (potential) calls to verify that there's nothing there that might die. Much more pragmatic to just assume that exceptions are always a possibility and code accordingly.
Edited to add: As a general rule, Perl5 and static code analysis don't really get along all that well. My understanding is that this is one of the motivations behind the language redesign in Perl6, so you may have better luck there.
Not seen anything like this but perhaps subroutine attributes may get your part of the way?
Here is a small proof of concept using Attribute::Handlers
ThrowsExceptionHandler.pm
package ThrowsExceptionHandler;
use Modern::Perl;
use Attribute::Handlers;
our #subs;
sub ThrowsException :ATTR(CODE) {
push #subs, {
package => $_[0],
symbol => $_[1],
subname => *{$_[1]}{NAME},
referent => $_[2],
attr => $_[3],
data => $_[4],
phase => $_[5],
filename => $_[6],
linenum => $_[7],
};
}
sub does_throw {
my ($class, $subname) = #_;
(grep { $_->{subname} eq $subname } #subs) ? 1 : 0;
}
1;
example.pl
use Modern::Perl;
use base qw(ThrowsExceptionHandler);
sub baz :ThrowsException {
die "Throws error";
}
sub foo {
warn "warning only";
}
say ThrowsExceptionHandler->does_throw( 'baz' ); # => 1
say ThrowsExceptionHandler->does_throw( 'foo' ); # => 0
Perhaps (a mixture of) PPI, Perl::Critic and/or Padre can be adapted to use something like this?
/I3az/
Have you checked CPAN? Error::TryCatch is one option, Exception::Class is another, etc. etc.
Also, see Object Oriented Exception Handling in Perl.
from document "Exceptions"
$# doesn't tell us where the error occurred
We can get around this with a custom function:
sub throw {
my $mess = join('', #_);
$mess =~ s/\n?$/\n/;
my $i = 1;
local $" = "', '";
package DB;
while (my #parts = caller($i++)) {
my $q; $q = "'" if #DB::args;
$mess .= " -> $parts3" .
" at $parts1 line $parts2\n";
}
die $mess;
}
With that you can also take references from "CPAN" and "Object Oriented Exception Handling in Perl"
One way I found is to check if the Perl Debugger is "loaded" by checking for defined($DB::single) and assuming Komodo is active, if $DB::single is defined..
But this might also mean the script is legitimately running as perl -d under the "standalone" debugger.
#!/usr/local/ActivePerl-5.10/bin/perl
use strict;
use warnings;
use feature qw/say switch/;
# detect debugger ..
SayDebugerStatus();
sub SayDebugerStatus {
print "Debugger ";
given ($DB::single) {
when (undef) {
say "not loaded.";
}
when (0) {
say "loaded but inactive";
}
default {
say "loaded and active";
}
}
return defined($DB::single) ? 1:0;
}
zakovyrya's suggestion leads to:
if ( grep( /.*Komodo\ IDE\.app/g, values %INC) ){
say "Komodo is running"
} else {
say "Komodo is not running"
};
But is there another way?
UPDATE today my isKomodo() routine failed. Some investigation showed, that IT changed my global path settings from "long" to "short" names (this is under Windows) .. there nolonger is a "KOMODO" string in the %INC hash..
I'm looking for a replacement.
What does your %INC contain when you launch script under Komodo? There is a good chance that some Komodo-specific modules are loaded.
It's better to print its content with:
use Data::Dumper;
print Dumper \%INC;
Seems like something like this is easier (for the script to know it's running under Komodo):
use Modern::Perl;
if (exists $ENV{'KOMODO_VERSION'}) {
say "Script is running under Komodo $ENV{'KOMODO_VERSION'} !";
} else {
say "script is not running in Komodo"
}
UPDATE(by 'lexu): KOMODO (7) now places KOMODO_VERSION in the environment
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.