File Coverage

blib/lib/Catmandu/Fix/assoc.pm
Criterion Covered Total %
statement 28 28 100.0
branch 1 2 50.0
condition 4 5 80.0
subroutine 8 8 100.0
pod n/a
total 41 43 95.3


line stmt bran cond sub pod time code
1              
2             use Catmandu::Sane;
3 1     1   91583  
  1         3  
  1         6  
4             our $VERSION = '1.2018';
5              
6             use Moo;
7 1     1   8 use Catmandu::Util::Path qw(as_path);
  1         3  
  1         4  
8 1     1   795 use Catmandu::Util qw(is_hash_ref);
  1         2  
  1         52  
9 1     1   8 use namespace::clean;
  1         2  
  1         33  
10 1     1   6 use Catmandu::Fix::Has;
  1         2  
  1         3  
11 1     1   676  
  1         2  
  1         6  
12             with 'Catmandu::Fix::Builder';
13              
14             has path => (fix_arg => 1);
15             has keys_path => (fix_arg => 1);
16             has vals_path => (fix_arg => 1);
17              
18             my ($self) = @_;
19             my $keys_getter = as_path($self->keys_path)->getter;
20 2     2   20 my $vals_getter = as_path($self->vals_path)->getter;
21 2         41 as_path($self->path)->creator(
22 2         22 sub {
23             my ($val, $data) = @_;
24             if (is_hash_ref($val //= {})) {
25 2     2   7 my $keys = $keys_getter->($data);
26 2 50 100     12 my $vals = $vals_getter->($data);
27 2         32 $val->{shift @$keys} = shift @$vals while @$keys && @$vals;
28 2         34 }
29 2   66     23 $val;
30             }
31 2         38 );
32             }
33 2         14  
34             1;
35              
36              
37             =pod
38              
39             =head1 NAME
40              
41             Catmandu::Fix::assoc - associate two values as a hash key and value
42              
43             =head1 SYNOPSIS
44              
45             # {pairs => [{key => 'year', val => 2009}, {key => 'subject', val => 'Perl'}]}
46             assoc(fields, pairs.*.key, pairs.*.val)
47             # {fields => {subject => 'Perl', year => 2009}, pairs => [...]}
48              
49             =head1 SEE ALSO
50              
51             L<Catmandu::Fix>
52              
53             =cut