1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125
|
package Catmandu::Fix::Bind::each;
use strict;
use warnings;
use Catmandu::Sane;
use Moo;
use Catmandu::Util;
use Catmandu::Fix::Has;
with 'Catmandu::Fix::Bind';
has path => (fix_opt => 1);
has var => (fix_opt => 1);
has _root_ => (is => 'rw');
has flag => (is => 'rw', default => sub {0});
sub unit {
my ($self, $data) = @_;
$self->_root_($data);
$self->flag(0);
if (defined($self->path)) {
return Catmandu::Util::data_at($self->path, $data);
} else {
return $data;
}
}
sub bind {
my ($self, $data, $code, $name, $fixer) = @_;
if (!Catmandu::Util::is_hash_ref($data)) {
$data = $code->($data);
} else {
if ($self->flag == 1) {
return $data;
}
$self->flag(1);
while (my ($key, $value) = each %{$data}) {
my $scope;
my $mdata;
if ($self->var) {
$scope = $self->_root_;
$scope->{$self->var} = {
'key' => $key,
'value' => $value
};
} else {
$scope = $data;
$scope->{'key'} = $key;
$scope->{'value'} = $value;
}
# Fixes are done directly on $data, so no returns are needed.
$fixer->fix($scope);
delete $scope->{$self->var} if $self->var;
}
}
}
1;
__END__
=pod
=head1 NAME
Catmandu::Fix::Bind::each - a binder that executes fixes for every (key, value) pair in a hash
=head1 SYNOPSIS
# Create a hash:
# demo:
# nl: 'Tuin der lusten'
# en: 'The Garden of Earthly Delights'
# Create a list of all the titles, without the language tags.
do each(path: demo, var: t)
copy_field(t.value, titles.$append)
end
# This will result in:
# demo:
# nl: 'Tuin der lusten'
# en: 'The Garden of Earthly Delights'
# titles:
# - 'Tuin der lusten'
# - 'The Garden of Earthly Delights'
=head1 DESCRIPTION
The each binder will iterate over a hash and return a (key, value)
pair (see the Perl L<each|http://perldoc.perl.org/functions/each.html> function
for the inspiration for this bind) and execute all fixes for each pair.
The bind always returns a C<var.key> and C<var.value> pair which can be used
in the fixes.
=head1 CONFIGURATION
=head2 path
The path to a hash in the data.
=head2 var
The temporary field that will be created in the root of the record
containing a C<key> and C<value> field containing the I<key> and
I<value> of the iterated data (cfr. L<each|http://perldoc.perl.org/functions/each.html>).
=head1 SEE ALSO
L<Catmandu::Fix::Bind::list>
L<Catmandu::Fix::Bind>
=cut
|