How can I break on warnings in the perl debugger? - perl

I have a codepath that sometimes emits warnings. Since this path is used a lot of times I don't want to break on each pass. How can I break only on times it emits warnings?

You can use a "signal handler" for warnings and set a flag, then break when the flag is set.
our $warn_flag = 0;
$SIG{__WARN__} = sub { $warn_flag = 1; CORE::warn(#_) };
...
for $i (1 .. 1_000_000_000) {
do_something_that_might_warn();
$DB::single ||= $warn_flag;
$warn_flag = 0;
}

use warnings qw(FATAL);
This will convert warnings to errors in the lexical scope, which will automatically cause the debugger to break.

Related

Perl function/sub best practice

I have a really quick question. I have a program with a lot of functions that are run from main. Is it best practice to have the functions first and then the call from main, or the other way around?
For example:
sub myFunction {
#Do something
}
my $stuff = myFunction();
Or:
my $stuff = myFunction();
sub myFunction {
#Do something
}
Sorry for any ignorance, I do not have any formal training and I have seen it done both ways online. Thanks
I recommend placing your code at the bottom.
Issue 1
The latter snippet poor because myFunction is in scope of $stuff, but it shouldn't be. That's easy to fix though.
{
my $stuff = myFunction();
}
sub myFunction {
#Do something
}
Ok, so that's not a big issue since I place all top-level code in a block, even if it comes at the end. It looks cleaner to me that way, and it makes it easier to transform into a sub from which I can return.
sub myFunction {
#Do something
}
sub main {
return 0 if is_nothing_to_do();
my $stuff = myFunction();
...
return 0;
}
exit(main(parse_args));
Issue 2
Many languages require that you declare your subs before you call them. That's rarely needed in Perl, though there are a couple of scenarios where it is required. Subs with prototypes is one of those. If you wanted to place your code at the top, you would need to add declarations even before that.
sub myFunction(&#);
{
my $stuff = myFunction { ... } ...;
}
sub myFunction(&#) {
#Do something
}
You probably never have to do that since all but some rare uses of prototypes is discouraged, and the other scenarios are even rarer.
Issue 3
You might accidentally skip initialization code by placing your top-level code before your subroutines.
Compare:
print my_counter(), "\n"; # Warns, then prints a blank line
...
{
my $counter = 1;
sub my_counter {
return $counter++;
}
}
...
and
...
{
my $counter = 1;
sub my_counter {
return $counter++;
}
}
...
print my_counter(), "\n"; # Prints 1
Issue 4
Many languages require that you declare your subs before you call them, so more people will be more familiar with having the top-level code at the bottom.
It doesn't matter, so long as you're able to find the code that you need to find. I typically like to set up my code like this:
use strict;
use warnings;
exit main();
sub main {
do_this();
dont_do_that();
cant_you_read_the_signs();
return 0;
}
sub do_this {
....
}
...
Putting your main code in an actual function or block called "main" helps keep you from polluting the program with globals.

Preserve a variable's value across multiple subroutine calls in perl

Just wanted to know what was the best way to reserve the value of a variable across multiple calls to the same subroutine . i.e
$someList = &someRoutine(100, 200);
$someList2 = &someRoutine(100, 200);
sub someRoutine {
$someAddition = 0;
foreach $someSum (#_){
$someAddition += $someSum;
}
return $someAddition
}
print $someList;
print $someList2;
Basically, someList should print 300 and someList2 should print 600. How do i make it so that someList2 prints 600? i want $someAddition to be preserved across multiple subroutine calls.
There are several ways to do it. I'll demonstrate two of them:
First, in modern versions of Perl you can use state:
use feature qw/state/;
print someRoutine(100,200), "\n";
print someRoutine(100,200), "\n";
sub someRoutine {
state $someAddition = 0;
foreach my $someSum ( #_ ) {
$someAddition += $someSum;
}
return $someAddition;
}
In this version, the $someAddition variable will be initialized to zero once, and only once. From that point on, the value will be retained between calls.
Another version is using a lexical closure. Here's an example:
my $summer = makeSummer();
print $summer->(100,200), "\n";
print $summer->(100,200), "\n";
sub makeSummer {
my $someAddition = 0;
return sub {
$someAddition += $_ foreach #_;
return $someAddition;
}
}
The second version is a little more complex, but has two advantages. First, you can start a fresh summation simply by calling the makeSummer routine to manufacture a new closure. Second, it will work on any version of Perl 5, not just versions recent enough to have the newer state keyword.
If you are not concerned with initializing the stateful variable before the sub is declared, you can also do this:
my $someAddition;
sub someRoutine {
$someAddition = 0 unless defined $someAddition;
foreach my $someSum( #_ ) {
$someAddition += $someSum;
}
return $someAddition;
}
A fourth method makes use of package globals. I save this one for last because it's the most prone to abuse and mistakes. But here you go;
our $someAddition = 0;
someRoutine(100,200);
print "$someAddition\n";
someRoutine(100,200);
print "$someAddition\n";
sub someRoutine {
$someAddition += $_ foreach #_;
}
In this last version, $someAddition is a package global, and its global scope makes it available both inside and outside of any subroutines living within the same namespace.
I assume you're at least using a variant of Perl 5? It has been bad practice to use ampersands & on subroutine calls since the first version of Perl 5 twenty-two years ago.
It is also vital that you use strict and use warnings at the top of every Perl program, and declare your variables ay their first point of use with my. It is a measure that will uncover many simple coding errors that you can otherwise easily overlook.
Perl variable names should use only lower-case letters, digits, and underscores. Capital letters are reserved for global identifiers such as package names.
By far the simplest and most common way of creating a static variable is just to declare it outside the subroutine. Like this
use strict;
use warnings;
my $some_list = some_routine(100, 200);
my $some_list2 = some_routine(100, 200);
my $some_addition;
sub some_routine {
$some_addition += $_ for #_;
return $some_addition
}
print $some_list, "\n";
print $some_list2, "\n";
output
300
600
If you want to protect the variable from being accessed by any following code other than the subroutine, then just enclose them in braces, like this
{
my $some_addition;
sub some_routine {
$some_addition += $_ for #_;
return $some_addition
}
}
Take a look at Persistent Private Variables in "man perlsub".

Win32::Process::KillProcess not returing proper exitcode

I am writing a function in perl which will kill a process given its PID.
sub ShutPidForWindows()
{
require Win32::Process;
$PID = 1234;
$count = 0;
$ReturnStatus = 0;
$ExitCode = 0 ;
if ($PID == 0)
{
return ($ReturnStatus);
}
Win32::Process::KillProcess($PID, $ExitCode);
print "PID = ".$PID."\n";
print "Return Code = ".$ExitCode."\n";
if ($ExitCode)
{
$ReturnStatus = 1;
}
else
{
$ReturnStatus = 2;
}
return ($ReturnStatus);
}
when this function is executed it always returns 2. Even though the process 1234 does not exists.
The o/p I get is:
PID = 1234
Return Code = 0
Perl Doc says that ExitCode will be populated by the exit code returned by the process. Then ExitCode should be 1.
Am I doing anything wrong?
The problem is that you are using require instead of use to load the module. Sometimes this is OK, but you should always follow the examples in the module's documentation.
You must also always use strict and use warnings at the top of every Perl program you write. This will make it necessary to declare all of your variables, which should be done as close as possible to their first point of use. These measures will reveal many errors that you may otherwise overlook, and is especially important when you are asking others for help with your code.
If you examine $^E after the call to Win32::Process::KillProcess, you might see a value like
The parameter is incorrect
which should tell you that you did something wrong.

Detecting global destruction in Perl

I'd like to detect if my object is being DESTROY'd as part of global destruction, and print out a warning (as that'd clearly be an error and lead to data loss). The obvious way to do that would seem to be:
sub DESTROY {
my $self = shift;
# ⋮
if (i_am_in_global_destruction()) {
warn "I survived until global destruction";
}
}
but I have been unable to find a good way to detect global destruction (instead of normal refcount hit 0 destruction).
By "good way", I mean not this, which though it works on 5.10.1 and 5.8.8, probably breaks the second someone gives it an odd glance:
sub DESTROY {
$in_gd = 0;
{
local $SIG{__WARN__} = sub { $_[0] =~ /during global destruction\.$/ and $in_gd = 1 };
warn "look, a warning";
}
if ($in_gd) {
warn "I survived until global destruction";
}
}'
There's a module Devel::GlobalDestruction that uses a tiny bit of XS to let you get at the global destruction flag directly.
Update: since perl 5.14.0 there is a global variable ${^GLOBAL_PHASE} that will be set to "DESTRUCT" during global destruction. You should still generally use Devel::GlobalDestruction, since it works with perls back to 5.6. When installing on a perl with ${^GLOBAL_PHASE} it will use the built-in feature and not even require a C compiler to build.
A solution that is good enough for me is to set a flag in an END block.
package Whatever;
our $_IN_GLOBAL_DESTRUCTION = 0;
END {
$_IN_GLOBAL_DESTRUCTION = 1;
}

How can I detect recursing package calls in Perl?

I have a Perl project were I just had a problem by making a circular package call. The code below demonstrates the problem.
When this is executed, each package will call the other until all of the memory of the computer is consumed and it locks up. I agree that this is a bad design and that circular calls like this should not be made in the design, but my project is sufficiently big that I would like to detect this at run time.
I have read about the weaken function and Data::Structure::Util, but I have not figured out a way to detect if there is a circular package load (I am assume, because a new copy is being made at each iteration and stored in each copy of the $this hash). Any ideas?
use system::one;
my $one = new system::one();
package system::one;
use strict;
use system::two;
sub new {
my ($class) = #_;
my $this = {};
bless($this,$class);
# attributes
$this->{two} = new system::two();
return $this;
}
package system::two;
use strict;
use system::one;
sub new {
my ($class) = #_;
my $this = {};
bless($this,$class);
# attributes
$this->{one} = new system::one();
return $this;
}
Here, have some code too. :)
sub break_recursion(;$) {
my $allowed = #_ ? shift : 1;
my #caller = caller(1);
my $call = $caller[3];
my $count = 1;
for(my $ix = 2; #caller = caller($ix); $ix++) {
croak "found $count levels of recursion into $call"
if $caller[3] eq $call && ++$count > $allowed;
}
}
sub check_recursion(;$) {
my $allowed = #_ ? shift : 1;
my #caller = caller(1);
my $call = $caller[3];
my $count = 1;
for(my $ix = 2; #caller = caller($ix); $ix++) {
return 1
if $caller[3] eq $call && ++$count > $allowed;
}
return 0;
}
These are called like:
break_recursion(); # to die on any recursion
break_recursion(5); # to allow up to 5 levels of recursion
my $recursing = check_recursion(); # to check for any recursion
my $recursing = check_recursion(10); # to check to see if we have more than 10 levels of recursion.
Might CPAN these, I think. If anyone has any thoughts about that, please share.
The fact that these are in separate packages has nothing at all to do with the fact that this runs infinitely, consuming all available resources. You're calling two methods from within one another. This isn't circular reference, it's recursion, which is not the same thing. In particular, weaken won't help you at all. You'd get exactly the same effect from:
sub a {
b();
}
sub b {
a();
}
a();
The best way to avoid this is don't do that. More usefully, if you have to write recursive functions try not to use multiple functions in the recursion chain, but simply the one, so you have an easier time mentally keeping track of where your calls should terminate.
As to how to detect whether something like this is happening, you would have to do something simple like increment a variable with your recursion depth and terminate (or return) if your depth exceeds a certain value. But you really shouldn't have to rely on that, it's similar to writing a while loop and using an increment there to make sure your function doesn't run out of control. Just don't recurse over a set unless you know how and when it terminates.
Another relevant question would be what are you trying to accomplish in the first place?
I suggest making a routine called something like break_constructor_recursion() that uses caller() to examine the call stack like so:
Find out what method in what package just called me.
Look up the rest of the call stack seeing if that same method in that same package is anywhere further up.
If so, die() with something appropriate.
Then you add a call to break_constructor_recursion() in your constructors. If the constructor is being called from inside itself, it'll bomb out.
Now, this can throw false positives; it's not impossible for a constructor to be legitimately called inside itself. If you have issues with that, I'd say just have it look for some N additional occurrences of the constructor before it identifies an error. If there are 20 calls to system::two::new() on the stack, the chances that you aren't recursing are pretty low.
The classic break on double recursion is to use a state variable to determine if you are already inside a function:
{
my $in_a;
sub a {
return if $in_a; #do nothing if b(), or someone b() calls, calls a()
$in_a = 1;
b();
$in_a = 0;
}
}
You can do whatever you want if $in_a is true, but dieing or returning is common. If you are using Perl 5.10 or later you can use the state function instead of nesting the function in its own scope:
sub a {
state $in_a;
return if $in_a; #do nothing if b(), or someone b() calls, calls a()
$in_a = 1;
b();
$in_a = 0;
}
use warnings;
without warnings:
#!/usr/bin/perl
use strict;
sub foo {
foo();
}
foo();
-
$ perl script.pl
^C # after death
with warnings:
#!/usr/bin/perl
use strict;
use warnings;
sub foo {
foo();
}
foo();
-
$ perl script.pl
Deep recursion on subroutine "main::foo" at script.pl line 7.
^C # after death
Always always use warnings.
use warnings FATAL => qw( recursion );
#!/usr/bin/perl
use strict;
use warnings FATAL => qw( recursion );
sub foo {
foo();
}
foo();
-
$ perl script.pl
Deep recursion on subroutine "main::foo" at script.pl line 7.
$