Losing value of $@ ($EVAL_ERROR) on DESTROY

[CDeVilbiss]

I'm working on a system that uses Net::Telnet to run commands on a
remote system (among other things, allocating and freeing resources).

Stripping out the irrelevant stuff and paraphrasing, my problem stems
from this:

package TrackedResource;

sub new {
my ($class, $cleanup_sub) = @_;
my $self = { cleanup => $cleanup_sub };
return bless $self, $class;
}

sub DESTROY { shift->{cleanup}->() }

package main;

sub testcase {
my ($telnet) = @_;
my $resource = $telnet->cmd('allocate');
my $cleanup = new TrackedResource(sub {
$telnet->cmd("deallocate $resource"); # calls waitfor
});
# use resource for stuff
# blah blah
die "argh, this is bad"; # some exception happens here
undef->callSomething; # or here
# blah blah
return 'Success';
}

my $telnet = new Net::Telnet($host);
my $rc = eval { testcase($telnet); }
print qq{died with '$@'\n};
__END__

The script always displays a blank value for $@.
Having used a watch in the debugger, the problem seems to be
that the contents of the exception are lost when
Net::Telnet::waitfor does an eval while DESTROYing my
TrackedResource, which clears $@.

Are there any good strategies for dealing with this? What I really
want is to be able to see the content of the first exception that
occurs within my eval at the top-level, regardless of what happens
in any DESTROY blocks.

When I looked at the perlvar entry for $SIG{__DIE__}, there was
some verbiage about overriding CORE::GLOBAL::die. Are there
any better approaches to this problem than something like

my $global_exception;
$SIG{__DIE__} = sub {
$global_exception = @_ == 1 ? $_[0] : "@_";
delete $SIG{__DIE__};
}

# now run the test
__END__

Thanks in advance for any ideas.
Colin DeVilbiss

 

[xhoster]

I'm working on a system that uses Net::Telnet to run commands on a
remote system (among other things, allocating and freeing resources).

Stripping out the irrelevant stuff and paraphrasing, my problem stems
from this:

package TrackedResource;

sub new {
my ($class, $cleanup_sub) = @_;
my $self = { cleanup => $cleanup_sub };
return bless $self, $class;
}

sub DESTROY { shift->{cleanup}->() }

untested:

sub DESTROY {
my @save = ($@,$?,$!); #maybe others?
shift->{cleanup}->();
($@,$?,$!) = @save;
}

....

The script always displays a blank value for $@.
Having used a watch in the debugger, the problem seems to be
that the contents of the exception are lost when
Net::Telnet::waitfor does an eval while DESTROYing my
TrackedResource, which clears $@.

Xho