如何编辑Perl哈希转储中的一些值

Question

假设我有这些散列：

my $hash1 = {
firstname => 'john',
lastname => 'doe',
};
my $hash2_nested = {
name => {
firstname => 'jean',
lastname => 'doe',
}
};

注意：散列可以嵌套x次。

我想使用Data:：Dumper，在那里我可以打印这些哈希的副本，但带有隐藏的姓氏。意思是，它应该打印出来：

$VAR1 = {
'firstname' => 'john'
'lastname' => '***',
};
and this:
$VAR1 = {
'name' => {
'firstname' => 'john'
'lastname' => '***',
}
};

有没有Perl库可以递归搜索哈希键并动态替换其值？类似于：

replace_hash_value($hash1, 'lastname', '***');

Answer 1

这里有几件事需要考虑。大多数情况下，你不想重新发明已经存在的东西。还要记住，尽管你尽了最大努力，你程序中的任何个人识别信息(PII(都会泄露出去，但这不是手头的编程问题。

首先，你不想对原始数据进行操作，而且由于你有嵌套结构，你不能简单地进行复制，因为它只复制顶层，但仍在底层共享引用：

my %copy = %original;  # shallow copy!

但是，核心模块Storable可以制作一个完全断开连接的深度拷贝，一个不共享引用的新拷贝：

use Storable qw(dclone);
my $deep_copy = dclone $hash1;

现在，您可以在不更改$hash1的情况下玩$deep_copy。您希望找到所有last_name密钥并删除它们的值。Grinz建议使用Data:：Walk模块(Visitor设计模式的一个示例(。它类似于数据结构的File:：Find。它将为您处理所有查找哈希的业务。在wanted子例程中，跳过所有不感兴趣的内容，然后更改感兴趣的节点。您不必担心如何找到或获得节点：

use Data::Walk;
walk &wanted, $deep_copy;
sub wanted {
return unless ref $_ eq ref {};
return unless exists $_->{last_name};
$_->{last_name} = '****';
}

现在，把这些放在一起。这里混合了嵌套的东西，并加入了一些奇怪的情况，包括一个使用哈希的对象：

use v5.10;
use Hash::AsObject;
my $data = {
first_name => 'Amelia',
last_name => 'Camel',

friends => [
q(last_name => 'REDACTED BY POLICY'),
{
first_name => 'Camelia',
last_name => 'Butterfly',
},
{
first_name => 'Larry',
last_name => 'Llama',
associate => {
first_name => 'Vicky',
last_name => 'Vicuna',
}
},
],
name => {
first_name => 'Andy',
last_name => 'Alpaca',
},
object => bless {
first_name => 'Peter',
last_name => 'Python',
}, 'FooBar',
};
use Storable qw(dclone);
my $deep_copy = dclone( $data );
use Data::Walk;
walk &wanted, $deep_copy;
use Data::Dumper;
say Dumper( $deep_copy );
sub wanted {
return unless ref $_ eq ref {};
return unless exists $_->{last_name};
$_->{last_name} = '****';
}

这里是Data::Dumper的输出(你可以用它的一些设置来美化它(：

$VAR1 = {
'object' => bless( {
'first_name' => 'Peter',
'last_name' => 'Python'
}, 'Hash::AsObject' ),
'first_name' => 'Amelia',
'last_name' => '****',
'friends' => [
'last_name => 'REDACTED BY POLICY'',
{
'last_name' => '****',
'first_name' => 'Camelia'
},
{
'last_name' => '****',
'first_name' => 'Larry',
'associate' => {
'first_name' => 'Vicky',
'last_name' => '****'
}
}
],
'name' => {
'first_name' => 'Andy',
'last_name' => '****'
}
};

请注意，它在数组引用中找到散列，不接触对象，也不接触其中包含last_name =>的文字数据。

如果你不喜欢这些行为，那么你可以修改你在wanted中所做的事情，以说明你希望发生的事情。假设您也想查看某些对象，比如Hash:：AsObject对象。一种(多态的(方法是查找允许您调用last_name方法的对象(尽管这假设您可以给它一个参数来更改姓氏(：

sub wanted {
if( ref $_ eq ref {} and exists $_->{last_name} ) {
$_->{last_name} = '****';
}
# merely one way to do this
elsif( eval { $_->can('last_name') } ) {
$_->last_name( '****' );
}
}

现在，对象中的last_name成员也被编辑：

$VAR1 = {
'first_name' => 'Amelia',
'friends' => [
'last_name => 'REDACTED BY POLICY'',
{
'last_name' => '****',
'first_name' => 'Camelia'
},
{
'first_name' => 'Larry',
'associate' => {
'first_name' => 'Vicky',
'last_name' => '****'
},
'last_name' => '****'
}
],
'last_name' => '****',
'name' => {
'first_name' => 'Andy',
'last_name' => '****'
},
'object' => bless( {
'first_name' => 'Peter',
'last_name' => '****'
}, 'Hash::AsObject' )
};

wanted非常灵活，非常简单。

Answer 2

为什么不自己编写这样的子例程？

use strict;
use warnings;
use feature 'say';
my $hash1 = {
firstname => 'john',
lastname => 'doe'
};
my $hash2_nested = {
name => {
firstname => 'jean',
lastname => 'doe'
}
};
my $mask = 'lastname';
hash_mask($hash1,$mask);
hash_mask($hash2_nested,$mask);
sub hash_mask {
say "$VAR = {";
hash_mask_x(shift, shift, 1);
say "};";
}
sub hash_mask_x {
my $hash   = shift;
my $mask_k = shift;
my $depth  = shift;
my $indent = ' ' x 8;
my $space  = $indent x $depth;
while( my($k,$v) = each %{$hash} ) {
if (ref $v eq 'HASH') {
say $space . "$k => {";
hash_mask_x($v,$mask_k,$depth+1);
say $space . "}";
} elsif( $k eq $mask_k ) {
say $space . "'$k' => '*****'";
} else {
say $space . "'$k' => '$v'";
}
}
}

输出

$VAR = {
'lastname' => '*****'
'firstname' => 'john'
};
$VAR = {
name => {
'lastname' => '*****'
'firstname' => 'jean'
}
};