File Coverage

blib/lib/Catmandu/Fix/Bind/maybe.pm
Criterion Covered Total %
statement 26 26 100.0
branch 2 2 100.0
condition n/a
subroutine 10 10 100.0
pod 0 6 0.0
total 38 44 86.3


line stmt bran cond sub pod time code
1              
2             use Catmandu::Sane;
3 1     1   810  
  1         2  
  1         6  
4             our $VERSION = '1.2019';
5              
6             use Moo;
7 1     1   6 use Scalar::Util qw(reftype);
  1         2  
  1         5  
8 1     1   326 use namespace::clean;
  1         1  
  1         38  
9 1     1   5  
  1         1  
  1         27  
10             with 'Catmandu::Fix::Bind';
11              
12             # Copied from hiratara's Data::Monad::Maybe
13             my ($self, @values) = @_;
14             bless [@values], __PACKAGE__;
15 25     25 0 40 }
16 25         256  
17             my ($self) = @_;
18             bless \(my $d = undef), __PACKAGE__;
19             }
20 2     2 0 3  
21 2         5 my ($self, $mvar) = @_;
22             reftype $mvar ne 'ARRAY';
23             }
24              
25 40     40 0 52 my ($self, $mvar) = @_;
26 40         111  
27             if ($self->is_nothing($mvar)) {
28             {};
29             }
30 26     26 0 31 else {
31             $mvar->[0];
32 26 100       41 }
33 1         15 }
34              
35             my ($self, $data) = @_;
36 25         370 $self->just($data);
37             }
38              
39             my ($self, $mvar, $func) = @_;
40              
41 15     15 0 25 if ($self->is_nothing($mvar)) {
42 15         44 return $self->nothing;
43             }
44              
45             my $res;
46              
47             eval {$res = $func->($self->value($mvar));};
48              
49             if ($@) {
50             return $self->nothing;
51             }
52              
53             if (defined $res) {
54             return $self->just($res);
55             }
56             else {
57             return $self->nothing;
58             }
59             }
60              
61             my ($self, $mvar) = @_;
62             $self->value($mvar);
63             }
64              
65             1;
66              
67              
68             =pod
69 13     13 0 21  
70 13         22 =head1 NAME
71              
72             Catmandu::Fix::Bind::maybe - a binder that skips fixes if one returns undef or dies
73              
74             =head1 SYNOPSIS
75              
76             do maybe()
77             foo()
78             return_undef() # rest will be ignored
79             bar()
80             end
81              
82             =head1 DESCRIPTION
83              
84             The maybe binder computes all the Fix function and ignores fixes that throw exceptions.
85              
86             =head1 SEE ALSO
87              
88             L<Catmandu::Fix::Bind>
89              
90             =cut