File Coverage

blib/lib/Exception/Resumable.pm

Criterion	Covered	Total	%
statement	17	33	51.5
branch	7	16	43.7
condition			n/a
subroutine	2	3	66.6
pod	3	3	100.0
total	29	55	52.7

package Exception::Resumable;

=head1 NAME

Exception::Resumable -- resumable exceptions for Perl.

=head1 SYNOPSIS

    use Exception::Resumable;
    handle {
        ...
        raise $exception, @args;
        ...
    } exception_1 => sub { ...; return $value_to_use },
      qr/exception_2/ => sub { ...; raise $new_exception, @args },
      [qw(exception_3 exception_4)] => $value_to_use,
      { exception_5 => 1, exception_6 => 1 } => sub { ... };

=cut

$VERSION = '0.91';

require Exporter;
@ISA = 'Exporter';
@EXPORT = qw(handle raise);

sub handle(&@)
{
    my $body = shift;
    local @LAST_CATCH = @CATCH;
    local @CATCH = (@_, @CATCH);
    local (@_);
    if (wantarray) {
        my @ret = eval { $body->() };
        if ($@) {
            raise(ref($@) eq 'ARRAY' ? @{$@} : $@);
        } else {
            @ret;
        }
    } else {
        my $ret = eval { $body->() };
        if ($@) {
            raise(ref($@) eq 'ARRAY' ? @{$@} : $@);
        } else {
            $ret;
        }
    }
}

my $test;
if ($] < 5.010) {
    $test = <<'EOS';
              (ref $k eq 'CODE')
            ? $k->($err)
            : (ref $k eq 'Regexp')
            ? $err =~ /$k/
            : (ref $k eq 'ARRAY')
            ? grep { $_ eq $err } @$k
            : (ref $k eq 'HASH')
            ? exists $k->{$err}
            : $k eq $err
EOS
} else {
    $test = '$err ~~ $k';
}
eval q#
sub raise(*@)
{
    my $err = shift;
    my @c = @CATCH;
    local @CATCH = @LAST_CATCH;
    while (@c) {
        my ($k, $v) = splice @c, 0, 2;
        my $ok = # . $test . q#;
        return ref($v) eq 'CODE' ? $v->(@_) : $v if $ok;
    }
    die $err, @_;
}

sub test_raise(*)
{
    my $err = shift;
    my @c = @CATCH;
    local @CATCH = @LAST_CATCH;
    while (@c) {
        my ($k, $v) = splice @c, 0, 2;
        my $ok = # . $test . q#;
        return $k, $v if $ok;
    }
    return undef;
}
#;

1;
__END__