File: assoc.pm

package info (click to toggle)
libcatmandu-perl 1.2024-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 3,552 kB
  • sloc: perl: 17,037; makefile: 24; sh: 1
file content (56 lines) | stat: -rw-r--r-- 1,212 bytes parent folder | download
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
package Catmandu::Fix::assoc;

use Catmandu::Sane;

our $VERSION = '1.2024';

use Moo;
use Catmandu::Util::Path qw(as_path);
use Catmandu::Util       qw(is_hash_ref);
use namespace::clean;
use Catmandu::Fix::Has;

with 'Catmandu::Fix::Builder';

has path      => (fix_arg => 1);
has keys_path => (fix_arg => 1);
has vals_path => (fix_arg => 1);

sub _build_fixer {
    my ($self)      = @_;
    my $keys_getter = as_path($self->keys_path)->getter;
    my $vals_getter = as_path($self->vals_path)->getter;
    as_path($self->path)->creator(
        sub {
            my ($val, $data) = @_;
            if (is_hash_ref($val //= {})) {
                my $keys = $keys_getter->($data);
                my $vals = $vals_getter->($data);
                $val->{shift @$keys} = shift @$vals while @$keys && @$vals;
            }
            $val;
        }
    );
}

1;

__END__

=pod

=head1 NAME

Catmandu::Fix::assoc - associate two values as a hash key and value

=head1 SYNOPSIS

   # {pairs => [{key => 'year', val => 2009}, {key => 'subject', val => 'Perl'}]}
   assoc(fields, pairs.*.key, pairs.*.val)
   # {fields => {subject => 'Perl', year => 2009}, pairs => [...]}

=head1 SEE ALSO

L<Catmandu::Fix>

=cut