File Coverage

blib/lib/Hash/Util/Merge.pm

Criterion	Covered	Total	%
statement	46	46	100.0
branch	1	2	50.0
condition	2	2	100.0
subroutine	10	10	100.0
pod	1	1	100.0
total	60	61	98.3

package Hash::Util::Merge;

use v5.14;
use warnings;

use Exporter 5.57 ();
use List::Util 1.45 ();
use Sub::Util 1.45 ();

our $VERSION = 'v0.3.0';

# ABSTRACT: utility functions for merging hashes


our @EXPORT_OK = qw/ mergemap /;

sub import {

    # This borrows a technique from List::Util that exports symbols $a
    # and $b to the callers namespace, so that function arguments can
    # simply use $a and $b, akin to how function arguments for sort
    # works.

    my $pkg = caller;
    no strict 'refs'; ## no critic (ProhibitNoStrict)
    ${"${pkg}::a"} = ${"${pkg}::a"};
    ${"${pkg}::b"} = ${"${pkg}::b"};
    goto &Exporter::import;
}


sub mergemap {

    my $pkg = caller;
    no strict 'refs'; ## no critic (ProhibitNoStrict)
    my $glob_a = \ *{"${pkg}::a"};
    my $glob_b = \ *{"${pkg}::b"};

    my $f = shift;
    my $x = shift // { };

    while (@_) {

        my $y = shift;

        my %r;
        for my $k ( List::Util::uniqstr( keys %$x, keys %$y ) ) {
            next if exists $r{$k};
            local *$glob_a = \$x->{$k};
            local *$glob_b = \$y->{$k};
            $r{$k} = $f->();
        }

        $x = \%r;

    }

    return $x;
}

BEGIN {
    Sub::Util::set_prototype '&@' => \&mergemap;
}


1;

__END__