繼這個問題之后，我使用了那里的答案（也貼在這里），現在我得到了一個失敗。
我知道失敗可能來自于"return bless $self->merge($left, $right), $class_left;"一行，但我不明白問題出在哪里。
我的代碼：
#!usr/bin/perl。
use strict;
使用警告。
use Hash::Merge;
use Data::Dumper;
$Data::Dumper::Sortkeys = 1;
使用 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
"); # I added this line for DEBUGGING.
if ($class_left && $class_left eq $class_right) {
unbless $left;
解除對$right的束縛。
return bless $self->merge（$left, $right）, $class_left;
} else {
# 常規標量，使用舊的行為。
return $old_behavior_scalar_scalar->（$left, $right）。
}
};
my $hash3 = $merger->merge($hash2, $hash1);
print Dumper（$hash3）。
輸出：
子程式"Hash::Merge::merge"在./rrr行40上的深度遞回。
在...../freeware/cpan/5.18的匿名子程式上深度遞回。 4/1/el-7-x86_64/lib/perl5/Hash/Merge.pm行227。
而在加入除錯行后：
left = SCALAR(0x2db6d70)，class_left = SCALAR right = SCALAR(0x2db6d88)，class_right = SCALAR
左 = SCALAR(0x2db7268), class_left = SCALAR 右 = SCALAR(0x2db7280) , class_right = SCALAR
左 = SCALAR(0x2db7760), class_left = SCALAR 右 = SCALAR(0x2db7778) , class_right = SCALAR
左 = SCALAR(0x2db9e40), class_left = SCALAR 右 = SCALAR(0x2db9e58) , class_right = SCALAR
左 = SCALAR(0x2dba338), class_left = SCALAR 右 = SCALAR(0x2dba350) , class_right = SCALAR
左 = SCALAR(0x2dba830), class_left = SCALAR 右 = SCALAR(0x2dba848) , class_right = SCALAR
左 = SCALAR(0x2dbad28), class_left = SCALAR 右 = SCALAR(0x2dbad40), class_right = SCALAR
.... #endless lines[/span
****之后的編輯：****
這種情況（神秘地）確實有效。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' )。
uj5u.com熱心網友回復：
問題是，unbless會遞回地解除其引數內的所有物件的bless。參考其檔案:
注意，該結構會在被祝福的物件中尋找其他物件來解除祝福。
在你的例子中，你的2個物件是被祝福的，它們各自包含一個內部的被祝福物件。在執行 unbless $left 之后，兩個祝福都被移除，而你永遠無法恢復內部的祝福。
為了解決這個問題，你可以撰寫你自己的unbless的實作，如下（為了簡單起見，假設不需要處理tyeglob）：
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." ;
}
這個函式的想法是，你可以像對待未受祝福的參考一樣解除對受祝福參考的參考，然后你可以獲取被解除參考的物件的參考，這將不會受到祝福。只是，要做到這一點，你需要知道參考的底層型別（標量、陣列ref、哈希ref）。上面的函式unbless用eval嘗試了所有的型別，并回傳有效的一個。
注意，它沒有修改它的引數，而是回傳一個無祝福的等價物。這意味著你需要做$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
"); # I added this line for DEBUGGING.
if ($class_left & & $class_left eq $class_right) {
if ($class_left eq 'SCALAR'/span>) {
return ($self->merge($left, $right))。
} else {
$left = unbless($left);
$right = unbless($right);
return bless $self->merge（$left, $right）, $class_left;
}
} else {
# 常規標量，使用舊的行為。
return $old_behavior_scalar_scalar->（$left, $right）。
}
};
轉載請註明出處，本文鏈接：https://www.uj5u.com/yidong/311322.html
標籤：