| CC: | srezic [...] iconmobile.com |
| Subject: | "tiedness" of hashes not preserved |
If two tied hashes are merged with Hash::Merge, then the tie property is
not preserved in the merged hash. At least this should be mentioned in
the documentation, but it's possible to specify a behavior to overcome
this limitation. The trick is to not create a new result hash, but to
merge into the existing left hash. See the attached script how this
could work. Maybe something similar could go into the standard
Hash-Merge distribution?
Regards,
Slaven
| Subject: | hash-merge-tie-ixhash.pl |
#!/usr/bin/perl
use strict;
use Test::More 'no_plan';
use Hash::Merge 'merge';
use Tie::IxHash;
{
tie my %hash1, 'Tie::IxHash';
%hash1 = map { ($_ => $_) } (1..10);
is join(" ", keys %hash1), join(" ", sort { $a <=> $b } keys %hash1), 'Keys are sorted';
my $merged = merge \%hash1, {};
local $TODO = "This does not work!";
is join(" ", keys %$merged), join(" ", sort { $a <=> $b } keys %$merged), 'Keys are still sorted after merge';
}
{
tie my %hash1, 'Tie::IxHash';
%hash1 = map { ($_ => $_) } (1..10);
is join(" ", keys %hash1), join(" ", sort { $a <=> $b } keys %hash1), 'Keys are sorted';
my $m = new_merge_into();
$m->merge(\%hash1, {});
is join(" ", keys %hash1), join(" ", sort { $a <=> $b } keys %hash1), 'Keys are still sorted';
}
{
tie my %hash1, 'Tie::IxHash';
%hash1 = map { ($_ => $_) } (1..10);
is join(" ", keys %hash1), join(" ", sort { $a <=> $b } keys %hash1), 'Keys are sorted';
tie my %hash2, 'Tie::IxHash';
%hash2 = map { ($_ => $_) } (11..20);
my $m = new_merge_into();
$m->merge(\%hash1, \%hash2);
is join(" ", keys %hash1), join(" ", sort { $a <=> $b } keys %hash1), 'Keys are still sorted';
}
sub new_merge_into {
my $m = Hash::Merge->new;
$m->specify_behavior
({
# basically this is LEFT_PRECEDENT with the case HASH ->
# HASH modified
'SCALAR' => {
'SCALAR' => sub { $_[0] },
'ARRAY' => sub { $_[0] },
'HASH' => sub { $_[0] },
},
'ARRAY' => {
'SCALAR' => sub { [ @{ $_[0] }, $_[1] ] },
'ARRAY' => sub { [ @{ $_[0] }, @{ $_[1] } ] },
'HASH' => sub { [ @{ $_[0] }, values %{ $_[1] } ] },
},
'HASH' => {
'SCALAR' => sub { $_[0] },
'ARRAY' => sub { $_[0] },
'HASH' => sub { _merge_into_hashes( $_[0], $_[1] ) },
},
});
$m;
}
sub _merge_into_hashes {
my $self = &Hash::Merge::_get_obj;
my ( $left, $right ) = ( shift, shift );
if ( ref $left ne 'HASH' || ref $right ne 'HASH' ) {
die 'Arguments for _merge_hashes must be hash references';
}
foreach my $leftkey ( keys %$left ) {
if ( exists $right->{$leftkey} ) {
$self->merge( $left->{$leftkey}, $right->{$leftkey} );
}
}
foreach my $rightkey ( keys %$right ) {
if ( !exists $left->{$rightkey} ) {
$left->{$rightkey} = $right->{$rightkey};
}
}
}