I'm trying to merge two blessed hashes in Perl.

I'm running the following code:

#!usr/bin/perl
use strict;
use warnings;
use Hash::Merge;
use Data::Dumper;
$Data::Dumper::Sortkeys = 1;

my $hash1 = bless( {
                 'CalcPorts' => {
                                  'helper_1' => {
                                                  'Scope' => [
                                                               ''
                                                             ],
  
                                                },
                                  'helper_2' => {
                                                  'Scope' => [
                                                               ''
                                                             ],
 
                                                },
                                },
 
               }, 'IB' );
my $hash2 = bless( {
                 'CalcPorts' => {
                                  'helper_2' => {
                                                  'Scope' => [
                                                               'd'
                                                             ],
 
                                                },
                                },
 
               }, 'IB' );

my $merger = Hash::Merge->new('LEFT_PRECEDENT');    
my $hash3 = $merger->merge($hash2, $hash1);

print Dumper($hash3);

The output is this:

$VAR1 = bless( {
                 'CalcPorts' => {
                                  'helper_2' => {
                                                  'Scope' => [
                                                               'd'
                                                             ]
                                                }
                                }
               }, 'IB' );

Even though I would have expected the "helper_1" to be there... Any ideas what am I doing wrong? Thanks for your help :)

CodePudding user response：

Hash::Merge considers that anything whose ref isn't HASH or ARRAY is a scalar, and applies the scalar merging rules on those items (see those lines of the implementation of Hash::Merge). When merging 2 scalars, Hash::Merge either discards one of them, or create an array to store them both. None of this options merges blessed hashes.

To overcome this issue, you can unbless your hashes first (using Data::Structure::Util::unbless for instance), then merge them, then rebless them:

use Data::Structure::Util qw(unbless);
my $class = ref $hash1;
unbless $hash1;
unbless $hash2;
my $hash3 = bless $merger->merge($hash2, $hash1), $class;

If you have blessed hashes within your main hashes, then you can define your own Hash::Merge behavior with the add_behavior_spec method: for the SCALAR-SCALAR case, check if both scalars are blessed references, and, if so, unbless, merge, and rebless:

$merger->add_behavior_spec(
    { 'SCALAR' => {
        'SCALAR' => sub {
            my $self  = &Hash::Merge::_get_obj;
            my ($left, $right) = @_;
            my ($class_left, $class_right) = (ref $left, ref $right);
            if ($class_left && $class_left eq $class_right) {
                unbless $left;
                unbless $right;
                return bless $self->merge($left, $right), $class_left;
            } else {
                return $_[1]; # Or something else
            }
        },
        'ARRAY'  => ...,
        'HASH'   => ...,
    },
    ARRAY => { ... },
    HASH  => { ... }

For conciseness, I've left ... for cases that are not relevant. You can copy-paste those from the source of Hash::Merger (choosing the behavior that you want). Or, maybe easier, you can use get_behavior_spec and get_behavior methods to change the SCALAR-SCALAR case of the current behavior:

my $behavior = $merger->get_behavior_spec($merger->get_behavior);
my $old_behavior_scalar_scalar = $behavior->{SCALAR}{SCALAR};
$behavior->{SCALAR}{SCALAR} = sub {
    my $self  = &Hash::Merge::_get_obj;
    my ($left, $right) = @_;
    my ($class_left, $class_right) = (ref $left, ref $right);
    if ($class_left && $class_left eq $class_right) {
        unbless $left;
        unbless $right;
        return bless $self->merge($left, $right), $class_left;
    } else {
        # Regular scalars, use old behavior
        return $old_behavior_scalar_scalar->($left, $right);
    }
};

Note that this does not handle well cases where you want to merge 2 hashes blessed to 2 different packages. You'll have to implement special cases for those. (it's not clear what a general rule for merging such hashes would be)