Perl -Deep recursion on subroutine "Hash::Merge::merge"-CodePudding

Following this question, I used the answer there (posted here too) and now I'm getting a failure. I understand that the failure probably comes from the line "return bless $self->merge($left, $right), $class_left;", but I don't understand what could be the problem.

My code:

#!usr/bin/perl
use strict;
use warnings;
use Hash::Merge;
use Data::Dumper;
$Data::Dumper::Sortkeys = 1;
use Data::Structure::Util qw(unbless);


my $hash1 = bless( {
    'Instance' => {
        'pipe_2' => {
            'LineNumber' => bless( do{\(my $o = '200773952')}, 'Veri::ColLineFile' )
        }
    },
}, 'IB' );

my $hash2 = bless( {
    'Instance' => {
        'pipe_2' => {
            'LineNumber' => bless( do{\(my $o = '200773952')}, 'Veri::ColLineFile' )
        }
    },
}, 'IB' );

my $merger = Hash::Merge->new('LEFT_PRECEDENT');
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);
    print("left = $left, class_left = $class_left right = $right, class_right = $class_right \n");  # I ADDED THIS LINE FOR DEBUGGING
    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);
    }
};
my $hash3 = $merger->merge($hash2, $hash1);

print Dumper($hash3);

Output:

Deep recursion on subroutine "Hash::Merge::merge" at ../rrr line 40.
Deep recursion on anonymous subroutine at ...../freeware/cpan/5.18.4/1/el-7-x86_64/lib/perl5/Hash/Merge.pm line 227.

and after adding the debugging line:

left = SCALAR(0x2db6d70), class_left = SCALAR right = SCALAR(0x2db6d88), class_right = SCALAR
left = SCALAR(0x2db7268), class_left = SCALAR right = SCALAR(0x2db7280), class_right = SCALAR
left = SCALAR(0x2db7760), class_left = SCALAR right = SCALAR(0x2db7778), class_right = SCALAR
left = SCALAR(0x2db9e40), class_left = SCALAR right = SCALAR(0x2db9e58), class_right = SCALAR
left = SCALAR(0x2dba338), class_left = SCALAR right = SCALAR(0x2dba350), class_right = SCALAR
left = SCALAR(0x2dba830), class_left = SCALAR right = SCALAR(0x2dba848), class_right = SCALAR
left = SCALAR(0x2dbad28), class_left = SCALAR right = SCALAR(0x2dbad40), class_right = SCALAR
.... #endless lines

*** AFTER EDIT: ***

This case (mysteriously) does work.

my $hash1 = bless( {
    'Instance' => {
        'pipe_2' => {
            'veri_id' => [
                bless( do{\(my $o = '201142064')}, 'Verific::VeriIdDef' )
            ]
        }
    },
}, 'IB' );

my $hash2 = bless( {
    'Instance' => {
        'pipe_2' => {
            'veri_id' => [
                bless( do{\(my $o = '201142064')}, 'Verific::VeriIdDef' )
            ]
        }
    },
}, 'IB' );

CodePudding user response：

The issue is that unbless unblesses all object within its argument recursively. Quoting its documentation:

Note that the structure looks inside blessed objects for other objects to unbless.

In your example, your 2 objects are blessed, and they each contain an internal blessed object. After doing unbless $left, both blesses are removed, and you can never recover the internal one.

To fix this, you can write your own implementation of unbless as follows (assuming that typeglob do not have to be handled, for simplicity):

sub unbless {
    my $r = eval { ${$_[0]} };
    return \$r unless $@;
    $r = eval { [ @{$_[0]} ] };
    return $r unless $@;
    $r = eval {  { %{$_[0]} } };
    return $r unless $@;
    die "Unable to unbless.";
}

The idea of this function is that you can dereference a blessed reference like you would an unblessed one, and then you can take the reference of the dereferenced object, which won't be blessed. Except that to do that, you need to know the underlying type of the reference (scalar, arrayref, hashref). The function unbless above tries all of them with eval, and return the one that works.

Note that instead of modifying its argument, it returns an unblessed equivalent. This means that you need to do $left = unbless $left instead of unbless $left. Also, don't forget to remove use Data::Structure::Util.

There is a second issue with your current code: it does not handle scalar references, one which it will loop forever. You can fix that by adding simple check for that case:

$behavior->{SCALAR}{SCALAR} = sub {
    my $self  = &Hash::Merge::_get_obj;
    my ($left, $right) = @_;
    my ($class_left, $class_right) = (ref $left, ref $right);
    print("left = $left, class_left = $class_left right = $right, class_right = $class_right \n");  # I ADDED THIS LINE FOR DEBUGGING
    if ($class_left && $class_left eq $class_right) {
        if ($class_left eq 'SCALAR') {
            return \($self->merge($$left, $$right));
        } else {
            $left = unbless($left);
            $right = unbless($right);
            return bless $self->merge($left, $right), $class_left;
        }
    } else {
        # Regular scalars, use old behavior
        return $old_behavior_scalar_scalar->($left, $right);
    }
};