sub DIE { 
  my $i=0; 
 
  while (my @info=caller($i++)) { 
        print STDERR "$info[3]($info[2]) "; 
 }                
  
  print STDERR ": "; 
  printf STDERR @_; 
  print STDERR "\n"; 
 
  exit 1; 
} 

##</code><code>##

main::DIE(16) main::foo(19) main::ack(22) main::bar(25) : HI

##</code><code>##

sub foo { 
        DIE "HI"; 
} 
sub ack { 
        foo; 
} 
sub bar { 
        ack; 
} 
 
bar(); 

##</code><code>##

sub DIE {
  my $i=0; 
  my $buff;

  while (my @info=caller($i++)) { 
        $buff.="$info[3]($info[2]) "; 
 }                

 die $buff;
}