$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"; } };