File Coverage

blib/lib/Catmandu/Fix/Bind/with.pm
Criterion Covered Total %
statement 22 25 88.0
branch 3 4 75.0
condition n/a
subroutine 8 9 88.8
pod 0 3 0.0
total 33 41 80.4


line stmt bran cond sub pod time code
1              
2             use Catmandu::Sane;
3 1     1   960  
  1         2  
  1         6  
4             our $VERSION = '1.2019';
5              
6             use Moo;
7 1     1   6 use Clone ();
  1         2  
  1         6  
8 1     1   349 use Catmandu::Util;
  1         2  
  1         15  
9 1     1   4 use namespace::clean;
  1         2  
  1         39  
10 1     1   7 use Catmandu::Fix::Has;
  1         2  
  1         26  
11 1     1   620  
  1         3  
  1         5  
12             with 'Catmandu::Fix::Bind', 'Catmandu::Fix::Bind::Group';
13              
14             has path => (fix_opt => 1);
15              
16             my ($self) = @_;
17             [];
18 0     0 0 0 }
19 0         0  
20             my ($self, $data) = @_;
21             defined $self->path ? Catmandu::Util::data_at($self->path, $data) : $data;
22             }
23 12     12 0 22  
24 12 100       169 my ($self, $mvar, $code) = @_;
25              
26             if (Catmandu::Util::is_hash_ref($mvar)) {
27             my $copy = Clone::clone($mvar);
28              
29             $copy = $code->($copy);
30              
31             if (ref($copy) eq 'reject') {
32              
33             #map { delete $mvar->{$_} } (keys %$mvar);
34             %$mvar = ();
35             }
36             else {
37             %$mvar = %$copy;
38             }
39              
40             return $mvar;
41             }
42             elsif (Catmandu::Util::is_array_ref($mvar)) {
43             my $idx = 0;
44             for my $item (@$mvar) {
45             $item = $code->($item);
46              
47             if (ref($item) eq 'reject') {
48             splice(@$mvar, $idx, 1);
49             }
50              
51             $idx++;
52             }
53             return $mvar;
54             }
55             else {
56             return $self->zero;
57             }
58             }
59              
60             my ($self, $var) = @_;
61             return bless $var, 'reject' if ref($var);
62             return bless \$var, 'reject';
63             }
64              
65 2     2 0 9 1;
66 2 50       12  
67 0            
68             =pod
69              
70             =head1 NAME
71              
72             Catmandu::Fix::Bind::with - a binder that computes Fix-es in the context of a path
73              
74             =head1 SYNOPSIS
75              
76             # Input data
77             data:
78             - name: patrick
79             - name: nicolas
80              
81             # Fix
82             do with(path:data)
83             if all_match(name,nicolas)
84             reject()
85             end
86             end
87              
88             # will produce
89             data:
90             - name: patrick
91              
92              
93             =head1 DESCRIPTION
94              
95             The C<with> bind allows to run fixes in the scope of a path.
96              
97             Given a deep nested data structure :
98              
99             my:
100             deep:
101             field:
102             name: James Brown
103              
104             these two fixes are equal:
105              
106             add_field(my.deep.field.style, funk)
107              
108             do with(path:my.deep.field)
109             add_field(style,funk)
110             end
111              
112             =head1 CONFIGURATION
113              
114             =head2 path
115              
116             The path to a list in the data.
117              
118             =head1 SEE ALSO
119              
120             L<Catmandu::Fix::Bind>
121              
122             =cut