ネストされた構造内の同一のブランチを参照で簡単に置き換える方法はありますか？

Question

任意の大きなネストされたハッシュと配列の構造をスキャンし、すべての同じブランチ（例えば、Test::Deep::cmp_deeplyが 'ok'と言っているもの）を単一の値への参照で置き換えることができる、Perl用のモジュールがありますか？

私はこの問題のために私自身の解決策をすでに持っていますが、既存の高速XSモジュールがあれば使用したいと考えています。 Data::Dumperによって示されるように、元の構造の

例：期待される結果構造の

$VAR1 = { 
    'other_elems' => [ 
     { 
      'sub_elements' => [ 
       {'id' => 333}, 
       { 
        'props' => ['attr5', 'attr6'], 
        'id' => 444 
       } 
      ], 
      'other_key_for_attrs' => ['attr1', 'attr5'], 
      'id'     => 222 
     }, 
     { 
      'sub_elements' => [{'id' => 333}], 
      'id'   => 111 
     } 
    ], 
    'elems' => [ 
     { 
      'attrs' => ['attr1', 'attr5'], 
      'id' => 1 
     }, 
     { 
      'parent' => 3, 
      'attrs' => ['attr1', 'attr5'], 
      'id'  => 2 
     }, 
     { 
      'attrs' => ['attr5', 'attr6'], 
      'id' => 3 
     }, 
     { 
      'attrs' => ['attr5', 'attr6'], 
      'id' => 4 
     } 
    ] 
}; 

例：

$VAR1 = { 
    'other_elems' => [ 
     { 
      'sub_elements' => [ 
       {'id' => 333}, 
       { 
        'props' => ['attr5', 'attr6'], 
        'id' => 444 
       } 
      ], 
      'other_key_for_attrs' => ['attr1', 'attr5'], 
      'id'     => 222 
     }, 
     { 
      'sub_elements' => 
       [$VAR1->{'other_elems'}[0]{'sub_elements'}[0]], 
      'id' => 111 
     } 
    ], 
    'elems' => [ 
     { 
      'attrs' => $VAR1->{'other_elems'}[0]{'other_key_for_attrs'}, 
      'id' => 1 
     }, 
     { 
      'parent' => 3, 
      'attrs' => $VAR1->{'other_elems'}[0]{'other_key_for_attrs'}, 
      'id'  => 2 
     }, 
     { 
      'attrs' => 
       $VAR1->{'other_elems'}[0]{'sub_elements'}[1]{'props'}, 
      'id' => 3 
     }, 
     { 
      'attrs' => 
       $VAR1->{'other_elems'}[0]{'sub_elements'}[1]{'props'}, 
      'id' => 4 
     } 
    ] 
}; 

Answer 1

私はどのようなモジュールを知りませんが、作業はとても楽しいように聞こえました私は比較のためにあなたに私の実装を提供します。これはデータ構造を横断する際にシリアライゼーション作業を複製するので（シリアル化された文字列を構築する際にリーフ要素から上に横断するように書き直すことができるため）、かなり大きな非効率性があることに注意してください。

#!/usr/bin/env perl 
use warnings; 
use strict; 

use Data::Dumper; 

my $hash = { 
    foo => ['bar', {baz => 3}], 
    qux => [{baz => 3}, ['bar', {baz => 3}]] 
}; 

{ 
    local $Data::Dumper::Sortkeys = 1; 
    local $Data::Dumper::Indent = 0; 
    local $Data::Dumper::Terse = 1; 

    my %seen_branches; 
    my @refs_to_check = \(values %$hash); 
    while (my $ref = shift @refs_to_check) { 
     my $serial = Dumper($$ref); 
     if (my $existing = $seen_branches{$serial}) { 
      $$ref = $existing; 
     } else { 
      $seen_branches{$serial} = $$ref; 
      if (ref($$ref) eq 'ARRAY') { 
       push @refs_to_check, \(@{$$ref}); 
      } elsif (ref($$ref) eq 'HASH') { 
       push @refs_to_check, \(values %{$$ref}); 
      } 
     } 
    } 
} 

print Dumper $hash;