From: Eric Wilhelm <[EMAIL PROTECTED]>
> I found myself wanting to check whether some code had a $SIG{__DIE__} in
> it and realized I still had this silly module in my experiments
> directory.
>
> This throws an error whenever a $SIG{__DIE__} is assigned without a
> local(). Potentially useful in tests, or just via -M...
>
> (Yes, actually it throws an error when it gets deleted, but the point is
> to catch itself getting replaced.)
>
> That seems like it might be useful on CPAN and I'm not finding anything
> in a search, so it just needs a name? I thought about adding more
> features, but then that would just be feature creep.
>
> Should it be in Devel::?
>
> package Carp::NoSigDie;
>
> <snipped>
>
> Thoughts?
Why not make it slightly more general?
-----------------------------------------
package CarpIfForgotten;
use strict;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(makeSubThatCarpsIfForgotten);
use Carp;
use warnings;
my $ended = 0;
END {$ended = 1;};
sub makeSubThatCarpsIfForgotten {
my ($msg, $behaviour) = @_;
my $obj = {};
my $pkg = 'CarpOnDESTROY' . (0+\$obj);
{ no strict 'refs';
*{$pkg.'::DESTROY'} = sub {
return if $ended;
Carp::carp($msg)
};
}
$obj = bless $obj, $pkg;
if ($behaviour) {
return sub {
my $foo = $obj; # to keep a reference
goto &$behaviour
}
} else {
return sub {
my $foo = $obj; # to keep a reference
return;
}
}
}
1;
-----------------------------------------
# test1.pl
use CarpIfForgotten;
our $sub1 = makeSubThatCarpsIfForgotten( 'sub1 disappeared', sub
{print "sub1 called\n"});
our $sub2 = makeSubThatCarpsIfForgotten( 'sub2 disappeared', sub
{print "sub2 called\n"});
our $sub3 = makeSubThatCarpsIfForgotten( 'sub3 disappeared');
print "All set\n";
$sub1->();
$sub2->();
$sub3->();
print "All called\n";
undef $sub2;
print "Sub1 destroyed\n";
sleep(1);
$sub1->();
$sub3->();
print "Others called\n";
-----------------------------------------
# test2.pl
use CarpIfForgotten;
$SIG{__DIE__} = makeSubThatCarpsIfForgotten('someone changed the
__DIE__ handler!');
print "Set\n";
$SIG{__DIE__} = undef;
print "ReSet\n";
-----------------------------------------
There's a catch though ... if the $subN variables are 'my' instead of
'our' they are destroyed before the END{} block runs! Also if the
'$SIG{__DIE__} = undef;' is the last statement that runs, you are not
warned.
Before uploading to CPAN I'd allow specifying a subroutine to call in
place of the message that is to be carp()ed.
Jenda
===== [EMAIL PROTECTED] === http://Jenda.Krynicky.cz =====
When it comes to wine, women and song, wizards are allowed
to get drunk and croon as much as they like.
-- Terry Pratchett in Sourcery
