use strict;
use warnings;

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


# Your program here ....