$SIG{INT} = sub {
    my (@stack, $level);
    while (1) {
        my ($pkg, $fn, $ln, $sub) = caller($level++);
        if (!($pkg or $fn or $ln or $sub)) {
            for (my $i = 0; $i < @stack; $i++) {
                print " " x $i, $stack$i, "\n";
            }
            exit;
        }
    unshift @stack, "-> $pkg: $fn (line $ln) sub $sub";
    }
};
[download]