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
Related
I'm attempting to use the Net::MQTT::Simple package from cpan. The following is a modified version of the 'Object oriented' example on the same cpan page:
use Net::MQTT::Simple;
my $mqtt = Net::MQTT::Simple->new("test.mosquitto.org");
#This doesn't actually execute
print "After new";
$mqtt->run(
"test" => sub {
my ($topic, $message) = #_;
die "The building's on fire" if $message > 150;
},
"#" => sub {
my ($topic, $message) = #_;
print "[$topic] $message\n";
},
);
My script never seems to connect or at least the print line never gets executed. No error is reported and the program just hangs. The sever name is correct as I can connect via the mosquitto_sub client.
I feel like I'm missing something obvious. Any ideas/pointers on why this would be hanging?
It actually does execute. You are not seeing the output of it because of buffering.
Either add a newline to print:
print "After new\n";
Or enable autoflush:
$| = 1;
print "After new";
(If you look at the code of Net::MQTT::Simple you'll see that there are no blocking operations in the constructor at all. It's waiting for the messages in $mqtt->run, I guess there are no messages matching the topics you are subscribing to, so it appears to be "stuck")
I tried to do something very fancy in Perl, and I think I'm suffering the consequences. I don't know if what I was trying to do is possible, actually.
My main program creates a pipe like this:
pipe(my $pipe_reader, my $pipe_writer);
(originally it was pipe(PIPE_READER, PIPE_WRITER) but I changed to regular variables when I was trying to debug this)
Then it forks, but I think that is probably irrelevant here. The child does this:
my $response = Response->new($pipe_writer);
The constructor of Response is bare bones:
sub new {
my $class = shift;
my $writer = shift;
my $self = {
writer => $writer
};
bless($self, $class);
return($self);
}
Then later the child will write its response:
$response->respond(123, "Here is my response");
The code for respond is as follows:
sub respond {
my $self = shift;
my $number = shift;
my $text = shift;
print $self->{writer} "$number\n";
print $self->{writer} "$text\n";
close $self->{writer}
}
This triggers a strange compile error: 'String found where operator expected ... Missing operator before "$number\n"?' at the point of the first print. Of course this is the normal syntax for a print, except that I have the object property instead of a normal handle AND it happens to be a pipe, not a file handle. So now I'm wondering if I'm not allowed to do this.
From print
If you're storing handles in an array or hash, or in general whenever you're using any expression more complex than a bareword handle or a plain, unsubscripted scalar variable to retrieve it, you will have to use a block returning the filehandle value instead, ...
print { $files[$i] } "stuff\n";
print { $OK ? *STDOUT : *STDERR } "stuff\n";
(my emphasis)
So you need
print { $self->{writer} } "$number\n";
Or, per Borodin's comment
$self->{writer}->print("$number\n");
The syntax of print is special, see for example this post and this post. For one, after print must come either a "simple" filehandle or a block evaluating to one, as quoted above, to satisfy the parser.
But with the dereference (arrow) operator the filehandle is found to be an IO::File object† and so its parent's IO::Handle::print method is invoked on it.
Prior to v5.14 there had to be use IO::Handle; for this to work, though not anymore. See this post and links in it for more.
Note that print FILEHANDLE LIST is not an indirect method call,
even as it may appear to be. It is just a function call to the print builtin under rather special syntax rules. It is only with an explicit ->
that an IO::Handle method gets called.
† It is either blessed into the class as the method call is encountered (and fails), or at creation; I can't find it in docs or otherwise resolve whether filehandles are blessed at creation or on demand
perl -MScalar::Util=blessed -wE'
pipe(RD,WR);
say *WR{IO}; #--> IO::File=IO(0xe8cb58)
say blessed(WR)//"undef"; #--> undef
'
(warns of unused RD) We can't do this with lexical filehandles as they are not in the symbol table.
But once needed a filehandle is an IO::File or IO::Handle object (depending on Perl version).
I have a piece of Perl code somewhat like the following (strongly simplified): There are some levels of nested subroutine calls (actually, methods), and some of the inner ones do their own exception handling:
sub outer { middle() }
sub middle {
eval { inner() };
if ( my $x = $# ) { # caught exception
if (ref $x eq 'ARRAY') {
print "we can handle this ...";
}
else {
die $x; # rethrow
}
}
}
sub inner { die "OH NOES!" }
Now I want to change that code so that it does the following:
print a full stack trace for every exception that "bubbles up" all the way to the outermost level (sub outer). Specifically, the stack trace should not stop at the first level of "eval { }".
Not having to change the the implementation of any of the inner levels.
Right now, the way I do this is to install a localized __DIE__ handler inside the outer sub:
use Devel::StackTrace;
sub outer {
local $SIG{__DIE__} = sub {
my $error = shift;
my $trace = Devel::StackTrace->new;
print "Error: $error\n",
"Stack Trace:\n",
$trace->as_string;
};
middle();
}
[EDIT: I made a mistake, the code above actually doesn't work the way I want, it actually bypasses the exception handling of the middle sub. So I guess the question should really be: Is the behaviour I want even possible?]
This works perfectly, the only problem is that, if I understand the docs correctly, it relies on behaviour that is explicitly deprecated, namely the fact that __DIE__ handlers are triggered even for "die"s inside of "eval { }"s, which they really shouldn't. Both perlvar and perlsub state that this behaviour might be removed in future versions of Perl.
Is there another way I can achieve this without relying on deprecated behaviour, or is it save to rely on even if the docs say otherwise?
UPDATE: I changed the code to override die globally so that exceptions from other packages can be caught as well.
Does the following do what you want?
#!/usr/bin/perl
use strict;
use warnings;
use Devel::StackTrace;
use ex::override GLOBAL_die => sub {
local *__ANON__ = "custom_die";
warn (
'Error: ', #_, "\n",
"Stack trace:\n",
Devel::StackTrace->new(no_refs => 1)->as_string, "\n",
);
exit 1;
};
use M; # dummy module to functions dying in other modules
outer();
sub outer {
middle( #_ );
M::n(); # M::n dies
}
sub middle {
eval { inner(#_) };
if ( my $x = $# ) { # caught exception
if (ref $x eq 'ARRAY') {
print "we can handle this ...";
}
else {
die $x; # rethrow
}
}
}
sub inner { die "OH NOES!" }
It is not safe to rely on anything that the documentation says is deprecated. The behavior could (and likely will) change in a future release. Relying on deprecated behavior locks you into the version of Perl you're running today.
Unfortunately, I don't see a way around this that meets your criteria. The "right" solution is to modify the inner methods to call Carp::confess instead of die and drop the custom $SIG{__DIE__} handler.
use strict;
use warnings;
use Carp qw'confess';
outer();
sub outer { middle(#_) }
sub middle { eval { inner() }; die $# if $# }
sub inner { confess("OH NOES!") }
__END__
OH NOES! at c:\temp\foo.pl line 11
main::inner() called at c:\temp\foo.pl line 9
eval {...} called at c:\temp\foo.pl line 9
main::middle() called at c:\temp\foo.pl line 7
main::outer() called at c:\temp\foo.pl line 5
Since you're dieing anyway, you may not need to trap the call to inner(). (You don't in your example, your actual code may differ.)
In your example you're trying to return data via $#. You can't do that. Use
my $x = eval { inner(#_) };
instead. (I'm assuming this is just an error in simplifying the code enough to post it here.)
Note that overriding die will only catch actual calls to die, not Perl errors like dereferencing undef.
I don't think the general case is possible; the entire point of eval is to consume errors. You MIGHT be able to rely on the deprecated behavior for exactly this reason: there's no other way to do this at the moment. But I can't find any reasonable way to get a stack trace in every case without potentially breaking whatever error-handling code already exists however far down the stack.
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 am writing a Perl module, and I am using carp to throw a non-fatal warning back to the calling program.
The carp warning works fine - I am checking if an input parameter meets a certain condition - if it does not meet the condition, a warning is sent with carp and the module continues on using a default for the parameter instead of the one the calling program passed. The warning is just to notify that a default parameter is being used instead of the passed in parameter.
My problem is with my test script. My test script is sending in a bad parameter to the module, and I am trying to catch the warning message that comes back and make sure I got the correct warning message.
My module looks something like this:
else {
carp "value must be numeric - using default value";
}
and my test script looks like this:
eval {
#call to my module
};
like (
$#,
qr/value must be numeric/,
"Should abort on non-numeric value"
);
When I run the test, I can see the warning (it must be going to STDERR) on the screen, but the contents of the $# variable is '' - blank.
Here is the output from my test script:
t/04bad_method_calls....ok 10/12value must be numeric - using default value at ...
# Failed test 'Should abort on non-numeric value'
# at t/04bad_method_calls.t line 98.
t/04bad_method_calls....NOK 12
# '' doesn't match '(?-xism:value must be numeric)'
# Looks like you failed 1 test of 12.
If I change the carp to a croak, my test script works - it catches the error message (but I only want to warn, not abort).
To be honest, I don't have the best understanding of eval - maybe that is not the best way to catch the warning output from carp. I tried using $SIG{__WARN__}, but that was empty as well.
Is there any way to capture the output from carp? It's not the biggest deal since this is just in my test script, but I'd still like to get my test script to work properly.
Thanks in advance!
From this page, http://perldoc.perl.org/perlvar.html, it looks like you want to set the local $SIG{__WARN__} to a subroutine that will turn warnings into fatal errors for your test script. The example they give is:
local $SIG{__WARN__} = sub { die $_[0] };
eval $proggie;
Another way how to catch warnings and also all STDERR output:
my $stderr = '';
{
local *STDERR;
open STDERR, '>', \$stderr;
do_stuf_here();
}
like( $stderr, qr/my result/, 'test stderr output' );
One can make fancy test function:
sub stderr_test (&$$) {
my ( $code, $pattern, $text ) = #_;
my $result = '';
{
local *STDERR;
open STDERR, '>', \$result;
$code->();
}
if ( UNIVERSAL::isa( $pattern, 'Regexp' ) ) {
like( $result, $pattern, $text );
}
else {
is( $result, $pattern, $text );
}
}
# usage
stderr_test {do_stuf_here} qr/my expected STDERR output/,
'stderr is like';
stderr_test {do_stuf_here} 'my expected STDERR output',
'stderr is exactly';
If you're doing this from a test script, you can use of the Test::* modules that capture output for you. I tend to like Test::Output.