Perl Detecting DESTROY as result of die() - perl

Question

I have an object which I do lots of stuff to, and then finish up by calling a TidyUp() method which displays some stats about what happened.
As part of internal testing, I wanted to detect when these objects were being created, but not tidied up before the program exited, and in that case die.
So I added a flag to the object which is set in TidyUP(), and a DESTROY sub-routine for the class that dies if this flag isn't set.
This all works fine, but it has an unfortunate side-effect. If something else goes wrong in the program, which causes die to be called, then the global destruction fires off my DESTROY, which notices that the object hasn't been tidied and dies. The problem is that I lose the original die message at this point.
So I'd like to detect whether the destruction occurred as a result of a die, or just normal program exit, and only in the latter case add my new die.
I had a look at Detecting global destruction in Perl but I don't think that helps as I want to detected what triggered global destruction.

Answer 1

You could set a global flag before you check whether your objects are tidied up. Then you know in which phase your program is running. You could also try to register a callback when your program dies using $SIG{__DIE__}. Checking $? is not safe since it could be set by other means. Checking whether you're in global destruction should work, too. But the cleanest solution would be to store all objects that have to be tidied up in an extra array. Then you can loop over these objects whenever you want and do away with using DESTROY.

Answer 2

From playing around with this problem, I see that the call stack in the DESTROY method is slightly different depending on how the program exits. Maybe that could help:
package Foo;
sub new { bless [], __PACKAGE__ }
sub DESTROY {
my ($n,$pkg,$file,$line);
while (my #c=caller($n++)) {
($pkg,$file,$line) = #c;
}
print STDERR "DESTROY called via $file line $line\n";
}
my $foo = Foo->new;
if ($ARGV[0] eq 'die') { die } # line 11
if ($ARGV[0] eq 'exit') { exit } # line 12
# else passive exit
$ perl 14255585.pl die
Died at 14255585.pl line 11.
DESTROY called via 14255585.pl line 11
$ perl 14255585.pl exit
DESTROY called via 14255585.pl line 12
$ perl 14255585.pl foo
DESTROY called via 14255585.pl line 0
If the list of exit points in your program is small and well-defined, you could just enumerate them and handle them when the program ends. Otherwise, you could do some on-the-fly static code analysis to see what the likely cause of death is.

Answer 3

You can hook into $SIG{__DIE__}, the global exception handler:
#!/usr/bin/perl
use Modern::Perl;
package Foo;
my $DIED = 0;
BEGIN { $SIG{__DIE__} = sub { $DIED = 1 }; }
sub new { bless [0] }
sub DESTROY { die 'untidy' unless shift->[0] or $DIED }
sub tidy_up { shift->[0] = 1 }
package main;
my $foo = new Foo;
die if #ARGV; # line 13
$foo->tidy_up();
say 'success';
$ perl test.pl
success
$ perl test.pl die
Died at test.pl line 13.
Since that exception handler is installed globally, make sure you don't override an existing error handler. Signals::XSIG helps with that.