File Coverage

blib/lib/Catmandu/Fix/Bind/each.pm
Criterion Covered Total %
statement 26 26 100.0
branch 2 2 100.0
condition 2 3 66.6
subroutine 8 8 100.0
pod 0 1 0.0
total 38 40 95.0


line stmt bran cond sub pod time code
1              
2             our $VERSION = '1.2018';
3              
4             use strict;
5 1     1   1097 use warnings;
  1         3  
  1         31  
6 1     1   5  
  1         3  
  1         27  
7             use Catmandu::Sane;
8 1     1   4 use Moo;
  1         2  
  1         7  
9 1     1   7  
  1         2  
  1         32  
10             use Catmandu::Util;
11 1     1   364 use Catmandu::Fix::Has;
  1         2  
  1         38  
12 1     1   371 use Carp;
  1         3  
  1         8  
13 1     1   296  
  1         2  
  1         548  
14             with 'Catmandu::Fix::Bind', 'Catmandu::Fix::Bind::Group';
15              
16             has path => (fix_opt => 1);
17             has var => (fix_opt => 1);
18              
19             has _root_ => (is => 'rw');
20              
21             my ($self, $data) = @_;
22              
23 13     13 0 32 $self->_root_($data);
24              
25 13         53 if ($self->path && $self->path ne '.') {
26             return Catmandu::Util::data_at($self->path, $data);
27 13 100 66     98 }
28 2         14 else {
29             return $data;
30             }
31 11         168 }
32              
33             my ($self, $data, $code) = @_;
34              
35             if (!Catmandu::Util::is_hash_ref($data)) {
36             $code->($data);
37             }
38             else {
39             my @keys = sort keys %{$data};
40             for my $key (@keys) {
41             my $value = $data->{$key};
42             my $scope;
43              
44             if ($self->var) {
45             $scope = $self->_root_;
46              
47             $scope->{$self->var} = {'key' => $key, 'value' => $value};
48             }
49             else {
50             $scope = $data;
51             $scope->{'key'} = $key;
52             $scope->{'value'} = $value;
53             }
54              
55             $code->($scope);
56              
57             if ($self->var) {
58              
59             # Key and values can be updated
60             if (my $mkey = $scope->{$self->var}->{key}) {
61             $data->{$mkey} = $scope->{$self->var}->{value};
62             if ($mkey ne $key) {
63             delete $data->{$key};
64             }
65             }
66              
67             delete $scope->{$self->var};
68             }
69             else {
70             if (my $mkey = $scope->{key}) {
71             $data->{$mkey} = $scope->{value};
72             if ($mkey ne $key) {
73             delete $data->{$key};
74             }
75             }
76              
77             delete $scope->{'key'};
78             delete $scope->{'value'};
79             }
80             }
81             }
82              
83             return $data;
84             }
85              
86             1;
87              
88             =pod
89              
90             =head1 NAME
91              
92             Catmandu::Fix::Bind::each - a binder that executes fixes for every (key, value) pair in a hash
93              
94             =head1 SYNOPSIS
95              
96             # Create a hash:
97             # demo:
98             # nl: 'Tuin der lusten'
99             # en: 'The Garden of Earthly Delights'
100              
101             # Create a list of all the titles, without the language tags.
102             do each(path: demo, var: t)
103             copy_field(t.value, titles.$append)
104             end
105              
106             # This will result in:
107             # demo:
108             # nl: 'Tuin der lusten'
109             # en: 'The Garden of Earthly Delights'
110             # titles:
111             # - 'Tuin der lusten'
112             # - 'The Garden of Earthly Delights'
113              
114             # Upcase every key in the root hash
115             # foo: bar
116             # test: 1234
117             do each(path:., var: t)
118             upcase(t.key)
119             end
120              
121             # This will result in
122             # FOO: bar
123             # TEST: 1234
124              
125             =head1 DESCRIPTION
126              
127             The each binder will iterate over a hash and return a (key, value)
128             pair (see the Perl L<each|http://perldoc.perl.org/functions/each.html> function
129             for the inspiration for this bind) and execute all fixes for each pair.
130              
131             The bind always returns a C<var.key> and C<var.value> pair which can be used
132             in the fixes.
133              
134             =head1 CONFIGURATION
135              
136             =head2 path
137              
138             The path to a hash in the data.
139              
140             =head2 var
141              
142             The temporary field that will be created in the root of the record
143             containing a C<key> and C<value> field containing the I<key> and
144             I<value> of the iterated data.
145              
146             =head1 AUTHOR
147              
148             Pieter De Praetere, C<< pieter.de.praetere at helptux.be >>
149              
150             =head1 SEE ALSO
151              
152             L<Catmandu::Fix::Bind::list>
153             L<Catmandu::Fix::Bind>
154              
155             =cut