perl - Merge hashes with arrays with Hash::Merge

Question

I am trying to merge two hashes which contains one or more arrays using Hash::Merge. For example:

use strict;
use warnings;
use feature qw(say);

use Data::Dump qw(dump);
use Hash::Merge qw(merge);

my $h1 = { a => [ { aa => 1 }, 3 ] };
my $h2 = { a => [ { bb => 2 } ] };

my $hLeft  = merge( $h1, $h2 );
my $hRight = merge( $h2, $h1 );

say "  hLeft: " . dump($hLeft);
say " hRight: " . dump($hRight);

my $hDesired = { a => [ { aa => 1, bb => 2 }, 3 ] };
say "Desired: " . dump($hDesired);

This gives output:

  hLeft: { a => [{ aa => 1 }, 3, { bb => 2 }] }
 hRight: { a => [{ bb => 2 }, { aa => 1 }, 3] }
Desired: { a => [{ aa => 1, bb => 2 }, 3] }

How can I get the correct output using Hash::Merge ?

Answer 1

This can be done using Hash::Merge::specify_behavior :

use warnings;
use strict;
use Data::Dump 'dump';
use Hash::Merge;
use feature 'say';

Hash::Merge::specify_behavior
  ( {
     'SCALAR' => {
                 'SCALAR' => sub { $_[1] },
                 'ARRAY'  => sub { [ $_[0], @{$_[1]} ] },
                 'HASH'   => sub { $_[1] },
                },
     'ARRAY' => {
                'SCALAR' => sub { $_[1] },
                'ARRAY'  => &mergeArrays,
                'HASH'   => sub { $_[1] }, 
               },
     'HASH' => {
               'SCALAR' => sub { $_[1] },
               'ARRAY'  => sub { [ values %{$_[0]}, @{$_[1]} ] },
               'HASH'   => sub { Hash::Merge::_merge_hashes( $_[0], $_[1] ) }, 
              },
    }, 
    'My Behavior', 
  );

my $h1={a=>[{aa=>1},3]};
my $h2={a=>[{bb=>2}]};

my $hMerge=Hash::Merge::merge($h1,$h2);
say "hMerge: ".dump($hMerge);

sub mergeArrays{
    my ($a,$b)=@_;

    my ($na,$nb)=($#$a,$#$b);
    my @c;
    if ($na>$nb) {
        @c=@$a[($nb+1)..$na];
        return mergeArrays2($a,$b,@c,$nb);
    } else {
        @c=@$b[($na+1)..$nb];
        return mergeArrays2($a,$b,@c,$na);
    }
}

sub mergeArrays2{
    my ($a,$b,$c,$n)=@_;

    my $r=[];
    for my $i (0..$n) {
        if (ref($a->[$i]) && ref($b->[$i])) {
            push(@$r,Hash::Merge::_merge_hashes($a->[$i],$b->[$i]));
        } else {
            push(@$r,$a->[$i]);
        }
    }
    push(@$r,@$c);
    return $r;
}

Output:

hMerge: { a => [{ aa => 1, bb => 2 }, 3] }