my $dead = 0;

END { print "END: dead=$dead\n" }

sub DESTROY {
   print "DESTROY: @{$_[0]}\n";
   return if $dead;
   print "die...\n";
   $dead = 1;
   exit(1);
}

my $a = bless [1];
{ bless [2] }
print "at end";

__END__
DESTROY: 2
die...
DESTROY: 1
END: dead=1
[download]

Executive summary: What dpuu proposes is a mess, once you get it working.

Gory Details

Aside from the obvious limitation that there is absolutely no way to handle the signal other than by termination, it's tricky to get this to work.

Consider the following example:

END { kill 'INT', $$ }
sub DESTROY { print "@{$_[0]}\n"; exit(14); }
my $a = bless [1];
my $b = bless [2, $a];
[download]

This prints "2 main=ARRAY(0x80f01b4)" (or some such). Note that $a is not being destructed. Apparently, perl loses track of the fact that its reference count is going to zero before it calls the END block, and since the END block kills the process, there is no opportunity for mark-and-sweep.

If we don't worry about propagating the status properly, then we still have problems. Consider the following:

sub DESTROY { print "@{$_[0]}\n"; exit(14); }
my $a = bless [1];
my $b = bless [2, $a];
my $c = bless [3, $b];
[download]

which prints:

3 main=ARRAY(0x80f00c4)
1
[download]

It appears that exiting during mark-and-sweep terminates garbage collection.

Just dying once doesn't work either:

my $cleaning_up;
sub DESTROY {
    print "DESTROY @{$_[0]}\n";
    my $id = $_[0][0];
    @{$_[0]} = ();
    print "CLEAN $id\n";
    return if $cleaning_up++;
    exit(14);
}
my $a = bless [1];
my $b = bless [2, $a];
my $c = bless [3, $b];
[download]

which prints (under Perl 5.6.1 -- perl5.8.2 is OK):

DESTROY 3 main=ARRAY(0x80f00c4)
DESTROY 2 main=ARRAY(0x80f01b4)
DESTROY 1
CLEAN 1
[download]

The problem here is that the exit at the bottom of the call stack obliterates the stack up through destroying $c.

We can fix these problems like this (brace yourself):

use POSIX;
{
    # Fork off a parent whose role is to convert the exit status.
    my $pid = fork;
    defined($pid) or die "Fork failed because $!";
    if($pid) {
        {
            # TBD: This really ought to be `sub { kill $_[0], $pid }'
            # instead of "IGNORE", but that does bad things on
            # ctrl-C, probably because the child gets the signal
            # twice.
            local $SIG{INT} = "IGNORE";
            waitpid($pid,0);
        }
        kill &POSIX::WTERMSIG($?), $$
          if &POSIX::WIFSIGNALED($?);
        my $status = &POSIX::WEXITSTATUS($?);
        if(0x80 < $status && $status < 0xC0) {
            kill $status - 0x80, $$;
        }
        POSIX::_exit($status);
    }
}
my $termsig;
my $cleaning_up;
our $in_dtor;
sub DESTROY {
    # NOTE: Signals that arrive in this method but outside the eval
    # are still a problem.
    my $id = $_[0][0];
    local ($@, $?);
    eval {
        my $sub_dtor = $in_dtor;
        local $in_dtor = 1;
        print "DESTROY @{$_[0]}\n";
        my $id = $_[0][0];
        @{$_[0]} = ();
        print "CLEAN $id\n";
    };
    warn "Failed to deallocate $id: $@" if $@;
    return unless $termsig;
    return if $in_dtor || $cleaning_up++;
    exit(14);
}
eval {
    local $SIG{INT} = sub { $termsig = $_[0]; die "SIG$_[0]\n" };
    {
        my $a = bless [1];
        my $b = bless [2, $a];
        my $c = bless [3, $b];
    }
    0; # Must be here to make handler go out of scope last!
};
if($@) {
    die $@ unless $@ =~ /^SIG(\w+)$/;
}
END {
    if($termsig) {
        use Config;
        my @sigs = split(' ', $Config{sig_name});
        my $i=0;
        $i++ while $sigs[$i] ne $termsig;
        $? = 0x80 + $i;
    }
}
[download]

#!/usr/bin/perl -l
use strict;
use warnings;

my $sig;

END
{
  local $?;
  print "Handling signal $sig" if $sig;
}

$SIG{INT} = sub { $sig = shift; print "Got signal $sig" };

{
  package Foo;
  sub new { bless [$_[1]], $_[0] }
  sub DESTROY { print shift->[0], "->DESTROY()"; sleep 2 }
}

my $foo = new Foo "foo";
my $bar = new Foo "bar";

print "Now press Ctrl-C";
[download]

perlipc provides some more details. Look especially under Signals and Deferred Signals. Aparently Perl does some of the safer signal handling internally, in new versions anyways. Here's the relevant parts:

Prior to Perl 5.7.3 it was necessary to do as little as you possibly could in your handler; notice how all we do is set a global variable and then raise an exception. That's because on most systems, libraries are not re-entrant; particularly, memory allocation and I/O routines are not. That meant that doing nearly anything in your handler could in theory trigger a memory fault and subsequent core dump.

In Perl 5.7.3 and later to avoid these problems signals are "deferred"-- that is when the signal is delivered to the process by the system (to the C code that implements Perl) a flag is set, and the handler returns immediately. Then at strategic "safe" points in the Perl interpreter (e.g. when it is about to execute a new opcode) the flags are checked and the Perl level handler from %SIG is executed. The "deferred" scheme allows much more flexibility in the coding of signal handler as we know Perl interpreter is in a safe state, and that we are not in a system library function when the handler is called.

If you have an older version of Perl, you'll still need to watch out for potential problems. In either case, it's probably still best for you to just set a flag and handle it later instead of rethrowing the signal.

The problem with that approach is, of course, that you need to litter your code with checks of your flag-variable. If you're using a lot of modules (especially slow ones), then you might need to go through those modules' source code and add these same checks there. That seems incredibly non-scalable.

The delayed-handler approach is only necessary where you don't want to be interrupted. In the OP's case, change from the real signal handler to the delayed one at the very end of the program -- right before the destructors.