File Coverage

blib/lib/Catmandu/Fix/Condition/in.pm
Criterion Covered Total %
statement 29 29 100.0
branch 3 4 75.0
condition 4 6 66.6
subroutine 8 8 100.0
pod n/a
total 44 47 93.6


line stmt bran cond sub pod time code
1              
2             use Catmandu::Sane;
3 1     1   744  
  1         3  
  1         7  
4             our $VERSION = '1.2018';
5              
6             use Moo;
7 1     1   6 use Catmandu::Util::Path qw(as_path);
  1         2  
  1         6  
8 1     1   352 use namespace::clean;
  1         3  
  1         50  
9 1     1   5 use Catmandu::Fix::Has;
  1         11  
  1         10  
10 1     1   315  
  1         2  
  1         7  
11             has path1 => (fix_arg => 1);
12             has path2 => (fix_arg => 1);
13              
14             with 'Catmandu::Fix::Condition::Builder';
15              
16             my ($self) = @_;
17             my $path1_getter = as_path($self->path1)->getter;
18 1     1   12 my $path2_getter = as_path($self->path2)->getter;
19 1         8 sub {
20 1         15 my $data = $_[0];
21             my $vals1 = $path1_getter->($data);
22 14     14   21 my $vals2 = $path2_getter->($data);
23 14         218 return 0 unless @$vals1 && @$vals2 && @$vals1 == @$vals2;
24 14         206 for (my $i = 0; $i < @$vals1; $i++) {
25 14 50 66     78 no if $] >= 5.018, warnings => 'experimental::smartmatch';
      66        
26 13         32 return 0 unless $vals1->[$i] ~~ $vals2->[$i];
27 1     1   463 }
  1         2  
  1         7  
28 13 100       116 return 1;
29             }
30 9         146 }
31              
32 1         13 1;
33              
34              
35             =pod
36              
37             =head1 NAME
38              
39             Catmandu::Fix::Condition::in - only execute fixes the data in one path is contained in another
40              
41             =head1 SYNOPSIS
42              
43             #-------------------------------------------------------------------
44             # Compare single values
45             # foo => 42 , bar => 42 => in(foo,bar) -> true
46             if in(foo,bar)
47             add_field(forty_two,ok)
48             end
49            
50             # When comparing single values to an array: test if the value is
51             # contained in the array
52              
53             # foo => 1 , bar => [3,2,1] => in(foo,bar) -> true
54             if in(foo,bar)
55             add_field(test,ok)
56             end
57              
58             # foo => 42 , bar => [1,2,3] => in(foo,bar) -> false
59             unless in(foo,bar)
60             add_field(test,ok)
61             end
62              
63             # In the following examples we'll write in pseudo code the true/false
64             # values of some 'in()' comparissons
65              
66             # scalars vs arrays - check if the value is in the array
67             foo: 42 , bar: [1,2,3] in(foo,bar) -> false
68             foo: 1 , bar: [1,2,3] in(foo,bar) -> true
69              
70             # scalars vs hashes - check if the key is in the hash
71             foo: name , bar: { name => 'Patrick' } in(foo,bar) -> true
72             foo: name , bar: { deep => {name => 'Nicolas'}} in(foo,bar) -> false
73              
74             # array vs array - check if the contents is equal
75             foo: [1,2] , bar: [1,2] in(foo,bar) -> true
76             foo: [1,2] , bar: [1,2,3] in(foo,bar) -> false
77             foo: [1,2] , bar: [[1,2],3] in(foo,bar) -> false
78              
79             =head1 STATUS
80              
81             Be aware this function is experimental in many perl versions
82              
83             =head1 SEE ALSO
84              
85             L<Catmandu::Fix>
86              
87             =cut