File Coverage

blib/lib/Hash/Util/Merge.pm
Criterion Covered Total %
statement 38 38 100.0
branch 2 2 100.0
condition n/a
subroutine 8 8 100.0
pod 1 1 100.0
total 49 49 100.0


line stmt bran cond sub pod time code
1             package Hash::Util::Merge;
2              
3 1     1   102640 use v5.10.1;
  1         6  
4              
5 1     1   5 use strict;
  1         2  
  1         25  
6 1     1   4 use warnings;
  1         7  
  1         21  
7              
8 1     1   4 use Exporter ();
  1         1  
  1         54  
9              
10             our $VERSION = 'v0.1.1';
11              
12             # ABSTRACT: utility functions for merging hashes
13              
14              
15             our @EXPORT_OK = qw/ mergemap /;
16              
17             sub import {
18              
19             # This borrows a technique from List::Util that exports symbols $a
20             # and $b to the callers namespace, so that function arguments can
21             # simply use $a and $b, akin to how function arguments for sort
22             # works.
23              
24 1     1   7 my $pkg = caller;
25 1     1   6 no strict 'refs'; ## no critic (ProhibitNoStrict)
  1         1  
  1         110  
26 1         16 ${"${pkg}::a"} = ${"${pkg}::a"};
  1         2  
  1         4  
27 1         1 ${"${pkg}::b"} = ${"${pkg}::b"};
  1         3  
  1         2  
28 1         1625 goto &Exporter::import;
29             }
30              
31              
32             sub mergemap(&$$) { ## no critic (ProhibitSubroutinePrototypes)
33              
34 4     4 1 2290 my $pkg = caller;
35 1     1   5 no strict 'refs'; ## no critic (ProhibitNoStrict)
  1         2  
  1         140  
36 4         65 my $glob_a = \ *{"${pkg}::a"};
  4         9  
37 4         4 my $glob_b = \ *{"${pkg}::b"};
  4         16  
38              
39 4         8 my ($f, $x, $y) = @_;
40              
41 4         5 my %r;
42              
43 4         11 for my $k (keys %$x, keys %$y) {
44 15 100       46 next if exists $r{$k};
45 8         13 local *$glob_a = \ $x->{$k};
46 8         11 local *$glob_b = \ $y->{$k};
47 8         15 $r{$k} = $f->();
48             }
49              
50 4         10 return \%r;
51             }
52              
53              
54             1;
55              
56             __END__