File Coverage

blib/lib/Catmandu/Fix/mapping.pm
Criterion Covered Total %
statement 47 47 100.0
branch 2 2 100.0
condition n/a
subroutine 12 12 100.0
pod n/a
total 61 61 100.0


line stmt bran cond sub pod time code
1              
2             use Catmandu::Sane;
3 1     1   97724  
  1         3  
  1         5  
4             use Catmandu::Importer::CSV;
5 1     1   369 use Catmandu::Util::Path qw(as_path);
  1         3  
  1         33  
6 1     1   7 use Catmandu::Util qw(is_value);
  1         1  
  1         43  
7 1     1   5 use Clone qw(clone);
  1         1  
  1         34  
8 1     1   5 use Moo;
  1         1  
  1         32  
9 1     1   4 use namespace::clean;
  1         2  
  1         4  
10 1     1   298 use Catmandu::Fix::Has;
  1         2  
  1         3  
11 1     1   660  
  1         3  
  1         5  
12             with 'Catmandu::Fix::Builder';
13              
14             has file => (fix_arg => 1);
15             has keep => (fix_opt => 1);
16             has csv_args => (fix_opt => 'collect');
17             has dictionary => (is => 'lazy', init_arg => undef);
18              
19             my ($self) = @_;
20             Catmandu::Importer::CSV->new(
21 5     5   31 %{$self->csv_args},
22             file => $self->file,
23 5         85 header => 0,
24             fields => ['key', 'val'],
25             )->reduce(
26             {},
27             sub {
28             my ($dict, $pair) = @_;
29             $dict->{$pair->{key}} = $pair->{val};
30 25     25   35 $dict;
31 25         58 }
32 25         53 );
33             }
34 5         8  
35             my ($self) = @_;
36              
37             my $dict = $self->dictionary;
38 5     5   36 my $keep = $self->keep;
39              
40 5         64 sub {
41 5         15 my $data = $_[0];
42              
43             foreach my $k (keys %$dict) {
44 5     5   8 my $old_path = as_path($k);
45             my $new_path = as_path($dict->{$k});
46 5         17  
47 25         75 my $getter = $old_path->getter;
48 25         1397 my $deleter = $old_path->deleter;
49             my $creator = $new_path->creator;
50 25         376  
51 25         82 my $values = [map {clone($_)} @{$getter->($data)}];
52 25         432 $deleter->($data) unless $keep;
53             $creator->($data, shift @$values) while @$values;
54 25         48 }
  7         37  
  25         400  
55 25 100       273  
56 25         591 $data;
57             };
58             }
59 5         83  
60 5         42 1;
61              
62              
63             =pod
64              
65             =head1 NAME
66              
67             Catmandu::Fix::mapping - move several fields by a lookup table
68              
69             =head1 SYNOPSIS
70              
71             # field_mapping.csv
72             # AU,author
73             # TI,title
74             # PU,publisher
75             # Y,year
76              
77             # fields found in the field_mapping.csv will be replaced
78             # {AU => "Einstein"}
79             mapping(field_mapping.csv)
80             # {author => "Einstein"}
81              
82             # fields found in the field_mapping.csv with keep option will be copied
83             # {AU => "Einstein"}
84             mapping(field_mapping.csv, keep: 1)
85             # {AU => => "Einstein", author => "Einstein"}
86              
87             # values not found will be kept
88             # {foo => {bar => 232}}
89             mapping(field_mapping.csv)
90             # {foo => {bar => 232}}
91              
92             # in case you have a different seperator
93             mapping(field_mapping.csv, sep_char: |)
94              
95             =head1 SEE ALSO
96              
97             L<Catmandu::Fix>, L<Catmandu::Fix::lookup>
98              
99             =cut