File Coverage

blib/lib/Hash/Util/Merge.pm
Criterion Covered Total %
statement 39 39 100.0
branch 2 2 100.0
condition n/a
subroutine 9 9 100.0
pod 1 1 100.0
total 51 51 100.0


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