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