json - Perl - 比较两个嵌套哈希

Question

这是我的场景，其中有 2 个哈希值已从 2 个 JSON 文件解码。

我有 2 个复杂的哈希，

$hash1 = {k1=> { k11 => v1, k12 => v2}, k2 => { k21 => [v1, v2, v3] }}
$hash2 = {k1=> { k11 => v1, k12 => v2}, k2 => { k21 => [v3, v2, v1] }}

我想比较这两个散列是否相等，并使用了 Data::Compare 的 Compare 和 Test::More 的 is_deeply。两者都没有忽略数组的顺序。
我想比较忽略键 'k21' 的数组值的顺序。
我的应用程序从“keys %hash”填充数组，该数组给出随机顺序。
尝试了 Data::Compare 的“ignore_hash_keys”，但我的哈希有时可能很复杂，不想忽略。

键“k21”有时也可以有哈希数组。

$hash3 = {k1=> { k11 => v1}, k2 => { k21 => [{v3 => v31}, {v2 => v22}] }}

如何通过忽略数组顺序来比较如此复杂的散列。

Answer 1

您可以使用 Test::Deep ，它提供了 cmp_deeply。它比 Test::More 的 is_deeply 更通用。

use Test::Deep;

my $hash1 = {
    k1 => { k11 => 'v1', k12 => 'v2' }, k2 => { k21 => [ 'v1', 'v2', 'v3' ] } };
my $hash2 = {
    k1 => { k11 => 'v1', k12 => 'v2' }, k2 => { k21 => bag( 'v3', 'v2', 'v1' ) } };

cmp_deeply( $hash1, $hash2, );

诀窍是 bag() function ，它忽略了元素的顺序。

This does a bag comparison, that is, it compares two arrays but ignores the order of the elements [...]

---

更新:来自your comment :

How do I bag all array references inside hash dynamically

深入研究 Test::Deep 的代码表明可以覆盖它。我看了at Test::Deep自己先，发现有一个Test::Deep::Array ，它处理数组。所有处理 T::D 内部内容的包都有 a descend method .所以这就是我们需要 Hook 的地方。

Sub::Override非常适合暂时覆盖一些东西，而不是弄乱 typeglobs。

基本上我们需要做的就是在 Test::Deep::Array::descend 的最后一行替换对 Test::Deep::arrayelementsonly 的调用通过调用 bag()。其余的只是复制(缩进是我的)。对于小monkey-patching对现有代码稍加修改的副本通常是最简单的方法。

use Test::Deep;
use Test::Deep::Array;
use Sub::Override;

my $sub = Sub::Override->new(
    'Test::Deep::Array::descend' => sub {
        my $self = shift;
        my $got  = shift;

        my $exp = $self->{val};

        return 0 unless Test::Deep::descend( 
             $got, Test::Deep::arraylength( scalar @$exp ) );

        return 0 unless $self->test_class($got);

        return Test::Deep::descend( $got, Test::Deep::bag(@$exp) );
    }
);

my $hash1 = {
    k1 => { k11 => 'v1', k12 => 'v2' },
    k2 => { k21 => [ 'v1', 'v2', 'v3' ] }
};
my $hash2 = {
    k1 => { k11 => 'v1', k12 => 'v2' },
    k2 => { k21 => [ 'v3', 'v2', 'v1' ] }
};

cmp_deeply( $hash1, $hash2 );

这将使测试通过。

确保通过取消定义 $sub 或让它超出范围来重置覆盖，否则如果您的测试套件的其余部分也同样如此，您可能会有一些奇怪的惊喜使用 Test::Deep。