File Coverage

blib/lib/Try/Chain.pm
Criterion Covered Total %
statement 22 22 100.0
branch 4 4 100.0
condition n/a
subroutine 8 8 100.0
pod 1 1 100.0
total 35 35 100.0


line stmt bran cond sub pod time code
1             package Try::Chain; ## no critic (TidyCode)
2            
3 5     5   125812 use strict;
  5         10  
  5         144  
4 5     5   22 use warnings;
  5         6  
  5         149  
5 5     5   2105 use parent qw(Exporter);
  5         1288  
  5         23  
6 5     5   2530 use Try::Tiny qw(try catch finally);
  5         8883  
  5         2128  
7            
8             our $VERSION = '0.004';
9            
10             our @EXPORT_OK = qw(
11             try catch finally
12             try_chain
13             $call_m
14             $fetch_i $fetch_ei
15             $fetch_k $fetch_ek
16             );
17            
18             sub try_chain (&;@) { ## no critic (SubroutinePrototypes)
19 22     22 1 15006 my ( $chain_code, @more ) = @_;
20            
21             my $check_code = sub {
22             ## no critic (ComplexRegexes)
23 12 100   12   109 m{
24             \A \QCan't call method "\E .*? \Q" on an undefined value\E \b
25             | \A \QCan't locate object method "\E .*? \Q" via package\E \b
26             | \A \QCan't use an undefined value as a HASH reference\E \b
27             | \A \QCan't use an undefined value as an ARRAY reference\E \b
28             }xms
29             or die $_; ## no critic (RequireCarping)
30             ## use critic (ComplexRegexes)
31            
32 10         65 return ();
33 22         65 };
34            
35             return @more
36             ? try {
37 6     6   315 try { $chain_code->() } catch { $check_code->() };
  6         434  
  4         69  
38             } @more
39 22 100   12   113 : try { $chain_code->() } catch { $check_code->() };
  16         1162  
  8         162  
40             }
41            
42             our $call_m = sub { ## no critic (PackageVars)
43             my ( $self, $method, @more ) = @_;
44            
45             return $self ? $self->$method(@more) : ();
46             };
47            
48             our $fetch_i = sub { ## no critic (PackageVars)
49             my ( $array_ref, $index ) = @_;
50            
51             return $array_ref->[$index];
52             };
53             our $fetch_ei = sub { ## no critic (PackageVars)
54             my ( $array_ref, $index ) = @_;
55            
56             return exists $array_ref->[$index] ? $array_ref->[$index] : undef;
57             };
58            
59             our $fetch_k = sub { ## no critic (PackageVars)
60             my ( $hash_ref, $key ) = @_;
61            
62             return $hash_ref->{$key};
63             };
64             our $fetch_ek = sub { ## no critic (PackageVars)
65             my ( $hash_ref, $key ) = @_;
66            
67             return exists $hash_ref->{$key} ? $hash_ref->{$key} : undef;
68             };
69            
70             # $Id$
71            
72             1;
73            
74             __END__