File Coverage

File:blib/lib/TB2/CanTry.pm
Coverage:100.0%

linestmtbrancondsubcode
1package TB2::CanTry;
2
3
388
388
388
388
use TB2::Mouse ();
4
388
388
388
388
use TB2::Mouse::Role;
5
6our $VERSION = '1.005000_005';
7$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
8
9
10# I'm not ready to publish this. It doesn't deal with array return
11# values from the code or context.
12
13 - 29
=begin private

=item B<try>

    my $return_from_code          = $obj->try(sub { code });
    my($return_from_code, $error) = $obj->try(sub { code });

Works like eval BLOCK except it ensures it has no effect on the rest
of the test (ie. C<$@> is not set) nor is effected by outside
interference (ie. C<$SIG{__DIE__}>) and works around some quirks in older
Perls.

C<$error> is what would normally be in C<$@>.

It is suggested you use this in place of eval BLOCK.

=cut
30
31sub try {
32
7106
7106
    my( $self, $code, %opts ) = @_;
33
34
7106
    my $error;
35
7106
    my $return;
36    {
37
7106
7106
        local $!; # eval can mess up $!
38
7106
        local $@; # don't set $@ in the test
39
7106
        local $SIG{__DIE__}; # don't trip an outside DIE handler.
40
7106
7106
        $return = eval { $code->() };
41
7100
        $error = $@;
42    }
43
44
7100
100
100
    die $error if $error and $opts{die_on_fail};
45
46
7096
100
    return wantarray ? ( $return, $error ) : $return;
47}
48
49=end private
50
51=cut
52
53
388
388
388
388
no TB2::Mouse::Role;
54
551;