use strict;
use warnings;

sub caught () {
	# caught ( )
	my $cl = 1;
	my ($pack, $file, $sub);
	
	# occasionally $sub will end up undef; this is OK, but we don't want a
	# warning about it.  So, we're lexically disabling it.
	no warnings 'uninitialized';
	
	do {
	   ($pack,$file, undef, $sub) = caller($cl++);
	} until ($sub ne '(eval)');
	$cl--;
	
	(my $exc = $@) =~ s/(.*) at .*$/$1/s; #trim of 'at file line ##' msg.
	$exc=~ s/[\r\n]/\x1F/gs;              #replace line endings.
	
	return 'Caught exception ['.$exc.'] '
	   .($cl>0 ? "$cl evals deep " : '').'in '
	   .($sub  ? $sub : 'main');
}

eval q!die "This is a test"!; die caught if ($@);