File Coverage

blib/lib/Catmandu/Fix/lookup.pm
Criterion Covered Total %
statement 40 40 100.0
branch 6 6 100.0
condition 2 3 66.6
subroutine 11 11 100.0
pod n/a
total 59 60 98.3


line stmt bran cond sub pod time code
1              
2             use Catmandu::Sane;
3 1     1   91281  
  1         3  
  1         6  
4             our $VERSION = '1.2019';
5              
6             use Catmandu::Importer::CSV;
7 1     1   477 use Catmandu::Util::Path qw(as_path);
  1         5  
  1         39  
8 1     1   9 use Catmandu::Util qw(is_value);
  1         3  
  1         55  
9 1     1   6 use Moo;
  1         2  
  1         35  
10 1     1   5 use namespace::clean;
  1         2  
  1         5  
11 1     1   347 use Catmandu::Fix::Has;
  1         11  
  1         8  
12 1     1   845  
  1         3  
  1         6  
13             with 'Catmandu::Fix::Builder';
14              
15             has path => (fix_arg => 1);
16             has file => (fix_arg => 1);
17             has default => (fix_opt => 1, predicate => 1);
18             has delete => (fix_opt => 1);
19             has csv_args => (fix_opt => 'collect');
20             has dictionary => (is => 'lazy', init_arg => undef);
21              
22             my ($self) = @_;
23             Catmandu::Importer::CSV->new(
24 7     7   52 %{$self->csv_args},
25             file => $self->file,
26 7         118 header => 0,
27             fields => ['key', 'val'],
28             )->reduce(
29             {},
30             sub {
31             my ($dict, $pair) = @_;
32             $dict->{$pair->{key}} = $pair->{val};
33 36     36   47 $dict;
34 36         74 }
35 36         68 );
36             }
37 7         10  
38             my ($self) = @_;
39             my $path = as_path($self->path);
40             my $dict = $self->dictionary;
41 7     7   48 my $has_default = $self->has_default;
42 7         24 my $default = $self->default;
43 7         1108 my $delete = $self->delete;
44 7         30 $path->updater(
45 7         15 sub {
46 7         11 my $val = $_[0];
47             if (is_value($val) && defined(my $new_val = $dict->{$val})) {
48             return $new_val;
49 9     9   13 }
50 9 100 66     42 elsif ($delete) {
    100          
    100          
51 4         63 return undef, 1, 1;
52             }
53             elsif ($has_default) {
54 2         30 return $default;
55             }
56             return undef, 1, 0;
57 2         29 }
58             );
59 1         15 }
60              
61 7         173 1;
62              
63              
64             =pod
65              
66             =head1 NAME
67              
68             Catmandu::Fix::lookup - change the value of a HASH key or ARRAY index by
69             looking up its value in a dictionary
70              
71             =head1 SYNOPSIS
72              
73             # dictionary.csv
74             # id,planet
75             # 1,sun
76             # 2,earth
77             # 3,moon
78              
79             # values found in the dictionary.csv will be replaced
80             # {foo => {bar => 2}}
81             lookup(foo.bar, dictionary.csv)
82             # {foo => {bar => 'earth'}}
83              
84             # values not found will be kept
85             # {foo => {bar => 232}}
86             lookup(foo.bar, dictionary.csv)
87             # {foo => {bar => 232}}
88              
89             # in case you have a different seperator
90             lookup(foo.bar, dictionary.csv, sep_char: |)
91              
92             # delete value if the lookup fails:
93             lookup(foo.bar, dictionary.csv, delete: 1)
94              
95             # use a default value if the lookup fails:
96             lookup(foo.bar, dictionary.csv, default: 'default value')
97              
98             =head1 SEE ALSO
99              
100             L<Catmandu::Fix>, L<Catmandu::Fix::mapping>
101              
102             =cut