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
|
|
|
|
|
|
|
|