Perl - 比较两个嵌套哈希

Gir*_*ish 2 perl hash json perl-data-structures

这是我的场景,其中有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] }}
Run Code Online (Sandbox Code Playgroud)

我想比较这两个哈希的相等性,并使用Data :: Data的比较和Test :: More的is_deeply.两者都不会忽略数组的顺序.
我想比较忽略键'k21'的数组值的顺序.
我的应用程序从'keys%hash'填充数组,它提供随机顺序.
尝试了Data :: Compare的'ignore_hash_keys',但我的哈希有时可能很复杂而且不想忽略.

键'k21'有时也可以有哈希数组.

$hash3 = {k1=> { k11 => v1}, k2 => { k21 => [{v3 => v31}, {v2 => v22}] }}
Run Code Online (Sandbox Code Playgroud)

如何通过忽略数组顺序来比较这种复杂的哈希值.

sim*_*que 5

您可以使用测试::深,它提供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, );
Run Code Online (Sandbox Code Playgroud)

诀窍是bag()函数,它忽略了元素的顺序.

这做了一个包比较,也就是说,它比较了两个数组,但忽略了元素的顺序[...]


更新:来自您的评论:

如何动态地将所有数组引用打包到哈希中

一些挖掘Test :: Deep的代码表明它可以覆盖它.我首先查看了Test :: Deep本身,发现有一个Test :: Deep :: Array,它处理数组.处理T :: D内部内容的所有包都有一个descend方法.这就是我们需要加入的地方.

Sub :: Override非常适合临时覆盖东西,而不是搞乱使用typeglobs.

基本上所有我们需要做的是更换呼吁Test::Deep::arrayelementsonlyTest::Deep::Array::descend同一个呼叫的最后一行bag().其余的只是复制(缩进是我的).对于小猴子修补,现有代码的副本稍作修改通常是最简单的方法.

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 );
Run Code Online (Sandbox Code Playgroud)

这将使测试通过.

确保通过取消定义$sub或让它超出范围来重置覆盖,或者如果测试套件的其余部分也使用Test :: Deep,则可能会有一些奇怪的意外.