Perl

Question

在问题之后，我使用了那里的答案（也张贴在这里），现在我遇到了失败。我知道失败可能来自行“return bless $self->merge($left, $right), $class_left;”，但我不明白可能是什么问题。

我的代码：

#!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);

输出：

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.

添加调试行后：

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

*** 编辑后：***

这个案例（神秘地）确实有效。

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' );

Answer 1

问题是 unbless unblesses all object within its argument recursively. Quoting its documentation:

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

在您的示例中，您的 2 个对象是受祝福的，并且它们每个都包含一个内部受祝福的对象。做了unbless $left后，两个祝福都被移除了，而且你永远无法恢复内在的

要解决此问题，您可以按如下方式编写自己的 unbless 实现（为简单起见，假设不必处理 typeglob）：

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.";
}

这个函数的想法是，你可以像取消引用一个没有祝福的引用一样取消引用一个有祝福的引用，然后你可以获取被取消引用的对象的引用，它不会被祝福。除此之外，您还需要知道引用的基础类型（标量、arrayref、hashref）。上面的函数 unbless 尝试使用 eval 和 return 的所有方法。

请注意，它 return 不是修改其参数，而是一个未受祝福的等价物。这意味着您需要执行 $left = unbless $left 而不是 unbless $left。另外，不要忘记删除 use Data::Structure::Util.

您当前的代码还有第二个问题：它不处理标量引用，它将永远循环。您可以通过为该案例添加简单检查来解决此问题：

$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);
    }
};

Perl - 子例程的深度递归 "Hash::Merge::merge"

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

recursion