3

Test::Deep::cmp_deeply是否有一个现成的 Perl 模块可以扫描任意大的散列和数组嵌套结构并用仅引用单个值替换所有相同的分支（例如，会说“ok”的分支）？

对于这个问题，我已经有了自己的解决方案，但如果可用的话，我更愿意使用现有的快速 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
        }
    ]
};
4

1 回答 1

2

我不知道有任何这样的模块，但这个任务听起来很有趣，所以为了比较，我会给你我的实现。请注意，这具有相当大的低效率，因为它在遍历数据结构时重复了序列化工作（可以重新编写以从叶元素向上遍历，并在进行时构建序列化字符串）。

#!/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;
于 2012-04-29T01:48:51.670 回答