File Coverage

blib/lib/Catmandu/Fix/paste.pm
Criterion Covered Total %
statement 41 41 100.0
branch 6 6 100.0
condition n/a
subroutine 8 8 100.0
pod n/a
total 55 55 100.0


line stmt bran cond sub pod time code
1             package Catmandu::Fix::paste;
2              
3 1     1   106541 use Catmandu::Sane;
  1         3  
  1         8  
4              
5             our $VERSION = '1.2020';
6              
7 1     1   9 use Moo;
  1         4  
  1         5  
8 1     1   369 use Catmandu::Util qw(is_value is_code_ref);
  1         5  
  1         73  
9 1     1   518 use Catmandu::Util::Path qw(as_path);
  1         2  
  1         53  
10 1     1   7 use namespace::clean;
  1         2  
  1         4  
11 1     1   732 use Catmandu::Fix::Has;
  1         3  
  1         6  
12              
13             with 'Catmandu::Fix::Builder';
14              
15             has path => (fix_arg => 1);
16             has args => (fix_arg => 'collect');
17              
18             sub _build_fixer {
19 3     3   27 my ($self) = @_;
20 3         9 my $args = $self->args;
21 3         8 my $join_char = ' ';
22 3         4 my $getters = [];
23 3         50 my $creator = as_path($self->path)->creator;
24              
25 3         29 for (my $i = 0; $i < @$args; $i++) {
26 10         27 my $arg = $args->[$i];
27 10 100       40 if ($arg eq 'join_char') {
    100          
28 1         3 $join_char = $args->[$i + 1];
29 1         4 last;
30             }
31             elsif (my ($literal) = $arg =~ /^~(.*)/) {
32 1         5 push @$getters, $literal;
33             }
34             else {
35 8         28 push @$getters, as_path($arg)->getter;
36             }
37             }
38              
39             sub {
40 3     3   6 my $data = $_[0];
41 3         8 my $vals = [];
42 3         8 for my $getter (@$getters) {
43 9 100       27 if (is_code_ref($getter)) {
44 8         12 push @$vals, grep {is_value($_)} @{$getter->($data)};
  8         39  
  8         147  
45             }
46             else {
47 1         8 push @$vals, $getter;
48             }
49             }
50 3         70 $creator->($data, join($join_char, @$vals));
51 3         54 $data;
52 3         29 };
53             }
54              
55             1;
56              
57             __END__
58              
59             =pod
60              
61             =head1 NAME
62              
63             Catmandu::Fix::paste - concatenate path values
64              
65             =head1 SYNOPSIS
66              
67             # If you data record is:
68             # a: eeny
69             # b: meeny
70             # c: miny
71             # d: moe
72             paste(my.string,a,b,c,d) # my.string: eeny meeny miny moe
73              
74             # Use a join character
75             paste(my.string,a,b,c,d,join_char:", ") # my.string: eeny, meeny, miny, moe
76              
77             # Paste literal strings with a tilde sign
78             paste(my.string,~Hi,a,~how are you?) # my.string: Hi eeny how are you?
79              
80             # Paste works even when not all values are instantiated
81             paste(my.string,x,a,z) # my.string: eeny
82              
83             =head1 DESCRIPTION
84              
85             Paste places a concatenation of all paths starting from the second path into the first path.
86             Literal values can be pasted by prefixing them with a tilde (~) sign.
87              
88             When a path doesn't exist it is regarded as having an empty '' value.
89              
90             =head1 SEE ALSO
91              
92             L<Catmandu::Fix>
93              
94             =cut