1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
|
package HTML::FormHandler::Merge;
# ABSTRACT: internal hash merging
use warnings;
use Data::Clone;
use base 'Exporter';
our @EXPORT_OK = ( 'merge' );
our $matrix = {
'SCALAR' => {
'SCALAR' => sub { $_[0] },
'ARRAY' => sub { [ $_[0], @{ $_[1] } ] },
'HASH' => sub { $_[1] },
},
'ARRAY' => {
'SCALAR' => sub { [ @{ $_[0] }, $_[1] ] },
'ARRAY' => sub { [ @{ $_[0] }, @{ $_[1] } ] },
'HASH' => sub { $_[1] },
},
'HASH' => {
'SCALAR' => sub { $_[0] },
'ARRAY' => sub { $_[0] },
'HASH' => sub { merge_hashes( $_[0], $_[1] ) },
},
};
sub merge {
my ( $left, $right ) = @_;
my $lefttype =
ref $left eq 'HASH' ? 'HASH' :
ref $left eq 'ARRAY' ? 'ARRAY' :
'SCALAR';
my $righttype =
ref $right eq 'HASH' ? 'HASH' :
ref $right eq 'ARRAY' ? 'ARRAY' :
'SCALAR';
$left = clone($left);
$right = clone($right);
return $matrix->{$lefttype}{$righttype}->( $left, $right );
}
sub merge_hashes {
my ( $left, $right ) = @_;
my %newhash;
foreach my $leftkey ( keys %$left ) {
if ( exists $right->{$leftkey} ) {
$newhash{$leftkey} = merge( $left->{$leftkey}, $right->{$leftkey} );
}
else {
$newhash{$leftkey} = clone( $left->{$leftkey} );
}
}
foreach my $rightkey ( keys %$right ) {
if ( !exists $left->{$rightkey} ) {
$newhash{$rightkey} = clone( $right->{$rightkey} );
}
}
return \%newhash;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
HTML::FormHandler::Merge - internal hash merging
=head1 VERSION
version 0.40057
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2014 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
|
