Perl defines two internal pseudo-signals that you can trap. There’s one for die, which I covered in Override die with END or CORE::GLOBAL::die and eventually told you not to use. There’s also one for warn that’s quite safe to use when you need to intercept warnings.
To catch a warning, you set a signal handler for the __WARN__ pseudo-signal. The underscores around the name distinguish it from the external signals, such as INT and USR1. The value can be the name of a subroutine or a reference to a subroutine:
$SIG{__WARN__} = 'some_sub';
$SIG{__WARN__} = \&some_sub;
$SIG{__WARN__} = sub { ... };
Replacing the default behavior is a good use for a __WARN__ handler. The cluck subroutine from Carp turns the warning message into a backtrace. If you want that for all warnings, you set it up as early as possible:
BEGIN { $SIG{__WARN__} = \&Carp::cluck; }
You don’t need to change all warnings for the entire program, though. If you need to track down the code that triggers the warning, you probably want to limit your replacement behavior to the code you’re investigating:
{
local $SIG{__WARN__} = \&Carp::cluck;
...;
}
Let’s have more fun, though.
Something more fun
You can get more fancy though, because you can do almost anything you like. Here’s a little program that issues several warnings, which at first you won’t intercept. This is a nonsense program that only exists to generate warnings, some of which you may have never seen before. Note the use of Perl 5.12 for the completely legal .... Since you never call chomp, the runtime never gets a chance to make those fatal errors even though they compile just fine:
use warnings;
use v5.12;
sub chomp { ... };
*chomp = sub { ... };
chomp( $ARGV[0] );
my $sum;
exec 'Buster';
print (STDOUT), 1, 2, 3;
print $a;
accept( SOCKET, GENERIC );
connect( SOCKET, 'Mimi' );
chmod 777, 'Mimi';
open FOO, '|Buster|';
close FOO;
say 'At the end!';
The warnings are legion:
Ambiguous call resolved as CORE::chomp(), qualify as such or use & at warnings line 8.
print (...) interpreted as function at warnings line 14.
Useless use of a constant (2) in void context at warnings line 14.
Useless use of a constant (3) in void context at warnings line 14.
Statement unlikely to be reached at warnings line 14.
(Maybe you meant system() when you said exec()?)
Name "main::a" used only once: possible typo at warnings line 15.
Name "main::GENERIC" used only once: possible typo at warnings line 17.
Subroutine main::chomp redefined at warnings line 6.
Use of uninitialized value $ARGV[0] in scalar chomp at warnings line 8.
Can't exec "Buster": No such file or directory at warnings line 11.
Use of uninitialized value $_ in print at warnings line 14.
Use of uninitialized value $a in print at warnings line 15.
accept() on unopened socket GENERIC at warnings line 17.
connect() on unopened socket SOCKET at warnings line 18.
Can't open bidirectional pipe at warnings line 20.
Can't exec "Buster": No such file or directory at warnings line 20.
At the end!
Suppose that you wanted to count those warnings, though? You could set up a handler. Since many of those warnings are from the compile-phase, you have to set up the handler at compile time by using a BEGIN block:
use strict;
use warnings;
use v5.12;
BEGIN {
$SIG{__WARN__} = sub {
state $count = 0;
printf '[%04d] %s', $count++, @_;
};
}
sub chomp { ... };
*chomp = sub { ... };
chomp( $ARGV[0] );
my $sum;
exec 'Buster';
print (STDOUT), 1, 2, 3;
print $a;
accept( SOCKET, GENERIC );
connect( SOCKET, 'Mimi' );
chmod 777, 'Mimi';
open FOO, '|Buster|';
close FOO;
say 'At the end!';
Now you see each warning has a number:
[0000] Ambiguous call resolved as CORE::chomp(), qualify as such or use & at warnings line 14. [0001] print (...) interpreted as function at warnings line 17. [0002] Useless use of a constant (2) in void context at warnings line 17. [0003] Useless use of a constant (3) in void context at warnings line 17. [0004] Statement unlikely to be reached at warnings line 17. [0005] (Maybe you meant system() when you said exec()?) [0006] Name "main::a" used only once: possible typo at warnings line 18. [0007] Name "main::GENERIC" used only once: possible typo at warnings line 19. [0008] Subroutine main::chomp redefined at warnings line 13. [0009] Use of uninitialized value $ARGV[0] in scalar chomp at warnings line 14. [0010] Can't exec "Buster": No such file or directory at warnings line 16. [0011] Use of uninitialized value $_ in print at warnings line 17. [0012] Use of uninitialized value $a in print at warnings line 18. [0013] accept() on unopened socket GENERIC at warnings line 19. [0014] connect() on unopened socket SOCKET at warnings line 20. [0015] Can't open bidirectional pipe at warnings line 22. [0016] Can't exec "Buster": No such file or directory at warnings line 22. At the end!
That’s interesting, but it can be even more interesting. Can you label the ones that are from the compile phase? You can check the phase with the ${^GLOBAL_PHASE} variable added to Perl 5.14:
use v5.14;
BEGIN {
$SIG{__WARN__} = sub {
state $count = 0;
printf '[%04d] %s - %s', $count++, ${^GLOBAL_PHASE}, @_;
};
}
# ... rest of program
Now the output shows the phase too:
[0000] START - Ambiguous call resolved as CORE::chomp(), qualify as such or use & at warnings line 14. [0001] START - print (...) interpreted as function at warnings line 17. [0002] START - Useless use of a constant (2) in void context at warnings line 17. [0003] START - Useless use of a constant (3) in void context at warnings line 17. [0004] START - Statement unlikely to be reached at warnings line 17. [0005] START - (Maybe you meant system() when you said exec()?) [0006] START - Name "main::a" used only once: possible typo at warnings line 18. [0007] START - Name "main::GENERIC" used only once: possible typo at warnings line 19. [0008] RUN - Subroutine main::chomp redefined at warnings line 13. [0009] RUN - Use of uninitialized value $ARGV[0] in scalar chomp at warnings line 14. [0010] RUN - Can't exec "Buster": No such file or directory at warnings line 16. [0011] RUN - Use of uninitialized value $_ in print at warnings line 17. [0012] RUN - Use of uninitialized value $a in print at warnings line 18. [0013] RUN - accept() on unopened socket GENERIC at warnings line 19. [0014] RUN - connect() on unopened socket SOCKET at warnings line 20. [0015] RUN - Can't open bidirectional pipe at warnings line 22. [0016] RUN - Can't exec "Buster": No such file or directory at warnings line 22. At the end!
Now each phase has its own warning counter:
START-0000 Ambiguous call resolved as CORE::chomp(), qualify as such or use & at warnings line 15. START-0001 print (...) interpreted as function at warnings line 18. START-0002 Useless use of a constant (2) in void context at warnings line 18. START-0003 Useless use of a constant (3) in void context at warnings line 18. START-0004 Statement unlikely to be reached at warnings line 18. START-0005 (Maybe you meant system() when you said exec()?) START-0006 Name "main::a" used only once: possible typo at warnings line 19. START-0007 Name "main::GENERIC" used only once: possible typo at warnings line 20. RUN-0000 Subroutine main::chomp redefined at warnings line 14. RUN-0001 Use of uninitialized value $ARGV[0] in scalar chomp at warnings line 15. RUN-0002 Can't exec "Buster": No such file or directory at warnings line 17. RUN-0003 Use of uninitialized value $_ in print at warnings line 18. RUN-0004 Use of uninitialized value $a in print at warnings line 19. RUN-0005 accept() on unopened socket GENERIC at warnings line 20. RUN-0006 connect() on unopened socket SOCKET at warnings line 21. RUN-0007 Can't open bidirectional pipe at warnings line 23. RUN-0008 Can't exec "Buster": No such file or directory at warnings line 23. At the end!
This leads to a deliciously evil plan: what if you can stop your program from running if it had more warnings than it did on the last run? The Test::Perl::Critic::Progressive module that already does something similar for Perl::Critic. Inside this __WARN__, you can use a die to stop the program:
use strict;
use warnings;
use v5.12;
BEGIN {
my $file = "$0.warn";
my $count = {};
$SIG{__WARN__} = sub { # refactor when you figure it out
state $previous_counts = do {
unless( -e $file ) { my $hash = {} }
else {
local @ARGV = $file;
my $hash;
while( <> ) {
chomp;
my( $phase, $count ) = split;
$hash->{$phase} = $count;
}
$hash;
}
};
$count->{${^GLOBAL_PHASE}}++;
die "Too many warnings in ${^GLOBAL_PHASE}\n"
if $count->{${^GLOBAL_PHASE}} >
( $previous_counts->{${^GLOBAL_PHASE}} // 0 ); #/
printf '%s-%04d %s',
${^GLOBAL_PHASE}, $count->{${^GLOBAL_PHASE}}, @_;
};
END { # inside a BEGIN!
open my $f, '>', $file;
while( my( $k, $v ) = each %$count ) {
say $f "$k $v";
}
}
}
sub chomp { ... };
*chomp = sub { ... };
# chomp( @ARGV ); # uncomment for another warning
say 'At the end!';
When you run this, the program stops when it encounters more errors that it did before:
$ perl5.14.1 warnings START-0001 Ambiguous call resolved as CORE::chomp(), qualify as such or use & at warnings line 46. Too many warnings in RUN
Things to remember
- You can intercept warnings with
$SIG{__WARN__} - Set up
$SIG{__WARN__}in aBEGINto intercept warnings right away
Very interesting! And so simple.
Thank you for showing this.
If you know what you are doing, Perl is one of the best languages existing. :-)