use strict;
use warnings;
use base qw( Exporter );
use B::Deparse;
use Data::Dumper;
our @EXPORT = qw( local_eval );

#
# Use the & prototype to convert the {} block into a coderef
#
sub local_eval(&) {
    my $code = shift;
    my ($pkg,$file,$line) = caller();
    my $context = find_context($code);
    print Dumper($context);
    eval {
        $code->(@_);
    };
    if ($@) {
        my $exception = $@;
        # This will only work if the error contains something like thi
+s:
        #    "at local_err.pl line 36."
        my ($err_file,$err_line) = $exception =~ /at (.*?) line (\d+)/
+;
        if ($context->{$err_file}{$err_line}) {
            # Make sure $@ was not changed locally.
            $@ = $exception;
            return;
        }
        else {
            # Rethrow the exception
            die $exception;
        };
    }
}


#
# Deparse the passed codeblock, stripping out the file names and
# line numbers provided by the '-l' option.
sub find_context {
    my $code = shift;
    my $deparse = B::Deparse->new('-p','-l','-sC');
    my $src     = $deparse->coderef2text($code);

    #Expects things like: line 31 "local_err.pl"
    my @lines = $src =~ /^#line (\d+ ".*")$/mg;
    my %context = ();
    for my $entry (@lines) {
        my ($line,$file) = split / /,$entry,2;
        $file =~ s/^"|"$//g;
        $context{$file}{$line}++;
    }
    return \%context;
}

1;
[download]

use strict;
use warnings;
use LocalEval;

local_eval {
    print "hello\n";
    splode();
};
print "Should still run.\n";
[download]

I have it! Sort of. I can solve for the error message part by using diagnostics.pm which has perldiag as a database of error messages. I suspect the only way to solve for the location part is by causing some unique token to be embedded in a #line "..." ... directive in the eval block. I could write this manually or I could be clever and write a Module::Compile filter to automatically insert those blocks for me. For simplicity's sake, I vote for hardcoding.

Added: The above is the dumbest "Aha!" moment ever. I mean, it's good for *nothing*. I still haven't solved my problem. I just know what I have to do to solve the problem. It's ugly and painful. Blech. I think that to get good lookups into the perldiag I'll have to write a program that throws every error imaginable and traps them. This sounds like far more grunt work than I want to do. :-/ BUMMER!.

For simplicity's sake, I vote for hardcoding.

Hardcoding is hard.

   eval {
#line 1 SpecialZone1
       $code_ref->();
   };
#line 23 file.pl
[download]

You have to make sure "SpecialZone1" is unique.
You have to make sure "23" and "file.pl" are correct.

When I know I'm writing inside AI/Prolog/Engine/Primitive.pm and this is the eval part of perlcall2/2 I can say the following and reasonably bet that I'll get only those things meant for me. I still have the problem that I need to reset my line number after exiting the eval. On consideration, this requires automation because it is difficult to get right by hand all the time. Manual maintenance of this would *SUCK*.

eval {
#line 1 "AI::Prolog primitive: perlcall2/2"
    ...
};
#line ??? "Primitive.pm"
if ( my $e = $@ ) {
    if ( $e =~ m{at AI::Prolog primitive: perlcall2/2} ) {
        Got it!
    }
    elsif ...
}
[download]

⠤⠤ ⠙⠊⠕⠞⠁⠇⠑⠧⠊

Update: So in your example, you could do something like:

eval {
    $code_ref->();
};
if ( my $e = $@ ) { 
    if( UNIVERSAL::isa($e, 'Exception::Class') { 
        # handle exception here
    } else { 
        # parse string from die
    }
}
[download]

I believe you have missed the point. I'm looking at your "parse string from die" branch. Exception objects should be entirely ignorable as a problem space because it's already solved. If I throw them I can identify them and if someone else throws them I can identify them as not being mine. It's when I just get a string that I have to decide "thrown from this file and four lines up?"

⠤⠤ ⠙⠊⠕⠞⠁⠇⠑⠧⠊

Assuming I control the code being called I could imagine that it could be given advice about packaging up any exceptions it might report. My current problem assumes I don't control the code I'm about to call.

⠤⠤ ⠙⠊⠕⠞⠁⠇⠑⠧⠊

Yes, you have. Please imagine I'd named that variable $function_name all along and that there was a no strict 'refs'. That is, the error I said I was going to trigger was reasonable for that snippet. That said, if there was some other possible error then the rest of my problem still holds that it's difficult to catch things that happen within a eval {...} without also catching errors from inside that are used within the snippet.

⠤⠤ ⠙⠊⠕⠞⠁⠇⠑⠧⠊

#!/usr/bin/perl

use warnings;
use strict;

sub call_depth
{
  my $i = 1;
  $i++ while(caller($i));
  return $i - 1;
}

sub test_sub
{
  die "Internal die";
}

sub call_sub
{
  # Override $SIG{__DIE__} to get the callstack depth where we died.
  # If another sub overrides $SIG{__DIE__}, that's OK, because 
  # it means we must have gotten to an internal sub.
  # $die_call_depth is a lexical that the $SIG{__DIE__} handler will 
  # close around, so this can be called recursively. 
  my $die_call_depth = -1;
  $SIG{__DIE__} = sub { $die_call_depth = call_depth(); die @_; };

  eval {
    no strict 'refs';
    $_[0]->();
  };
  if ($@)
  {
    # die_call_depth will be our depth + 2: one for the eval, and one
    # for the $SIG{__DIE__} sub.
    if (($die_call_depth-2) == call_depth())
    {
      warn "No such sub $_[0]: $@";
    }
    else
    {
      warn "Failure inside sub $_[0]: $@";
    }
  }
}

call_sub('test_sub');
call_sub('flerp');
[download]

Failure inside sub test_sub: Internal die at t65 line 15.
No such sub flerp: Undefined subroutine &main::flerp called at t65 line 30.