File Coverage

blib/lib/Hash/Merge/Simple.pm
Criterion Covered Total %
statement 29 29 100.0
branch 6 8 75.0
condition 2 3 66.6
subroutine 7 7 100.0
pod 3 3 100.0
total 47 50 94.0


line stmt bran cond sub pod time code
1             package Hash::Merge::Simple;
2             BEGIN {
3 3     3   1459099 $Hash::Merge::Simple::VERSION = '0.051';
4             }
5             # ABSTRACT: Recursively merge two or more hashes, simply
6              
7 3     3   29 use warnings;
  3         6  
  3         90  
8 3     3   15 use strict;
  3         5  
  3         138  
9              
10 3     3   21 use vars qw/ @ISA @EXPORT_OK /;
  3         5  
  3         1154  
11             require Exporter;
12             @ISA = qw/ Exporter /;
13             @EXPORT_OK = qw/ merge clone_merge dclone_merge /;
14              
15              
16             # This was stoled from Catalyst::Utils... thanks guys!
17             sub merge (@);
18             sub merge (@) {
19 34 50   34 1 40907 shift unless ref $_[0]; # Take care of the case we're called like Hash::Merge::Simple->merge(...)
20 34         66 my ($left, @right) = @_;
21              
22 34 50       78 return $left unless @right;
23              
24 34 100       98 return merge($left, merge(@right)) if @right > 1;
25              
26 22         36 my ($right) = @right;
27              
28 22         71 my %merge = %$left;
29              
30 22         56 for my $key (keys %$right) {
31              
32 34         49 my ($hr, $hl) = map { ref $_->{$key} eq 'HASH' } $right, $left;
  68         159  
33              
34 34 100 66     110 if ($hr and $hl){
35 1         9 $merge{$key} = merge($left->{$key}, $right->{$key});
36             }
37             else {
38 33         83 $merge{$key} = $right->{$key};
39             }
40             }
41            
42 22         105 return \%merge;
43             }
44              
45              
46             sub clone_merge {
47 1     1 1 6744 require Clone;
48 1         5 my $result = merge @_;
49 1         19 return Clone::clone( $result );
50             }
51              
52              
53             sub dclone_merge {
54 1     1 1 41662 require Storable;
55 1         7 my $result = merge @_;
56 1         113 return Storable::dclone( $result );
57             }
58              
59              
60             1;
61              
62             __END__
63             =pod
64              
65             =head1 NAME
66              
67             Hash::Merge::Simple - Recursively merge two or more hashes, simply
68              
69             =head1 VERSION
70              
71             version 0.051
72              
73             =head1 SYNOPSIS
74              
75             use Hash::Merge::Simple qw/ merge /;
76              
77             my $a = { a => 1 };
78             my $b = { a => 100, b => 2};
79              
80             # Merge with righthand hash taking precedence
81             my $c = merge $a, $b;
82             # $c is { a => 100, b => 2 } ... Note: a => 100 has overridden => 1
83              
84             # Also, merge will take care to recursively merge any subordinate hashes found
85             my $a = { a => 1, c => 3, d => { i => 2 }, r => {} };
86             my $b = { b => 2, a => 100, d => { l => 4 } };
87             my $c = merge $a, $b;
88             # $c is { a => 100, b => 2, c => 3, d => { i => 2, l => 4 }, r => {} }
89              
90             # You can also merge more than two hashes at the same time
91             # The precedence increases from left to right (the rightmost has the most precedence)
92             my $everything = merge $this, $that, $mine, $yours, $kitchen_sink, ...;
93              
94             =head1 DESCRIPTION
95              
96             Hash::Merge::Simple will recursively merge two or more hashes and return the result as a new hash reference. The merge function will descend and merge
97             hashes that exist under the same node in both the left and right hash, but doesn't attempt to combine arrays, objects, scalars, or anything else. The rightmost hash
98             also takes precedence, replacing whatever was in the left hash if a conflict occurs.
99              
100             This code was pretty much taken straight from L<Catalyst::Utils>, and modified to handle more than 2 hashes at the same time.
101              
102             =head1 USAGE
103              
104             =head2 Hash::Merge::Simple->merge( <hash1>, <hash2>, <hash3>, ..., <hashN> )
105              
106             =head2 Hash::Merge::Simple::merge( <hash1>, <hash2>, <hash3>, ..., <hashN> )
107              
108             Merge <hash1> through <hashN>, with the nth-most (rightmost) hash taking precedence.
109              
110             Returns a new hash reference representing the merge.
111              
112             NOTE: The code does not currently check for cycles, so infinite loops are possible:
113              
114             my $a = {};
115             $a->{b} = $a;
116             merge $a, $a;
117              
118             NOTE: If you want to avoid giving/receiving side effects with the merged result, use C<clone_merge> or C<dclone_merge>
119             An example of this problem (thanks Uri):
120              
121             my $left = { a => { b => 2 } } ;
122             my $right = { c => 4 } ;
123              
124             my $result = merge( $left, $right ) ;
125              
126             $left->{a}{b} = 3 ;
127             $left->{a}{d} = 5 ;
128              
129             # $result->{a}{b} == 3 !
130             # $result->{a}{d} == 5 !
131              
132             =head2 Hash::Merge::Simple->clone_merge( <hash1>, <hash2>, <hash3>, ..., <hashN> )
133              
134             =head2 Hash::Merge::Simple::clone_merge( <hash1>, <hash2>, <hash3>, ..., <hashN> )
135              
136             Perform a merge, clone the merge, and return the result
137              
138             This is useful in cases where you need to ensure that the result can be tweaked without fear
139             of giving/receiving any side effects
140              
141             This method will use L<Clone> to do the cloning
142              
143             =head2 Hash::Merge::Simple->dclone_merge( <hash1>, <hash2>, <hash3>, ..., <hashN> )
144              
145             =head2 Hash::Merge::Simple::dclone_merge( <hash1>, <hash2>, <hash3>, ..., <hashN> )
146              
147             Perform a merge, clone the merge, and return the result
148              
149             This is useful in cases where you need to ensure that the result can be tweaked without fear
150             of giving/receiving any side effects
151              
152             This method will use L<Storable> (dclone) to do the cloning
153              
154             =head1 SEE ALSO
155              
156             L<Hash::Merge>
157              
158             L<Catalyst::Utils>
159              
160             L<Clone>
161              
162             L<Storable>
163              
164             =head1 ACKNOWLEDGEMENTS
165              
166             This code was pretty much taken directly from L<Catalyst::Utils>:
167              
168             Sebastian Riedel C<sri@cpan.org>
169              
170             Yuval Kogman C<nothingmuch@woobling.org>
171              
172             =head1 AUTHOR
173              
174             Robert Krimen <robertkrimen@gmail.com>
175              
176             =head1 COPYRIGHT AND LICENSE
177              
178             This software is copyright (c) 2010 by Robert Krimen.
179              
180             This is free software; you can redistribute it and/or modify it under
181             the same terms as the Perl 5 programming language system itself.
182              
183             =cut
184