如何观看特定的哈希键以更改其值?

时间:2019-02-13 09:07:29

标签: perl debugging tie

我有一个哈希,例如$hash->{'foo'}{'bar'}

我想在Carp::cluck键值更改的任何地方调用bar

该怎么做? CPAN上是否有任何现成的模块可以做到这一点?

3 个答案:

答案 0 :(得分:6)

my $hash = { foo => { bar => 1 } };
Internals::SvREADONLY( $hash->{foo}{bar}, 1 );
$hash->{foo}{bar} = 2;

产生

Modification of a read-only value attempted at -e line 4.

但这是一个致命错误,并且不包含跟踪(除非使用Carp :: Always)。

我建议在标量中添加 set magic

use Carp            qw( cluck );
use Variable::Magic qw( wizard cast );

my $wizard = wizard(
   set => sub {
      cluck("Warning: Modification of a read-only value attempted");
   },
);

my $hash = { foo => { bar => 1 } };
cast( $hash->{foo}{bar}, $wizard );
$hash->{foo}{bar} = 2;

产生

Warning: Modification of a read-only value attempted at -e line 6.
        main::__ANON__(SCALAR(0x4200c90), undef) called at -e line 12
        eval {...} called at -e line 12

tie可以完成相同的操作,但是会更昂贵。 (绑定变量基于magic。)

答案 1 :(得分:3)

Tie::Trace几乎可以带您到达那里。

use Tie::Trace 'watch';
my $hash = { foo => { bar => "original value" } };
watch $hash->{foo}{bar};
sub f1 { f2() }
sub f2 { f3() }
sub f3 { $hash->{foo}{bar} = "new value" }
f1();

输出:

'new value' at watch.pl line 6

您可以通过导入Carp::Always或猴子修补Tie::Trace::_carpit函数或使用$SIG{__WARN__}处理程序(如

)来使输出产生完整的堆栈跟踪
$SIG{__WARN__} = sub {
    if (caller(0) eq 'Tie::Trace') {
        # warning is from Tie::Trace
        Carp::cluck(@_);
    } else {
        CORE::warn(@_);
    }
};
...

答案 2 :(得分:0)

我已经完成了一个“简单”功能,它不适用于包含数组的哈希:

use v5.28;
use Storable qw(dclone);

my $ori = {
    'hola' => {
        'hola' => 'adios',
        'adios' => 'hola'
    },
    'hey' => 'you'
};
my $copy = dclone($ori);
$ori->{'hola'}{'adios'} = {'good', 'bye', 'hello', 'year'};
compare($ori, $copy, sub { say $_[0]; });

sub compare {
    my $original = shift;
    my $copy = shift;
    my $func = shift;
    for my $el (keys %{$original}) {
        if (ref $original->{$el} eq ref {}) {
                compare($original->{$el}, ref $copy->{$el} 
                        eq ref {} ? $copy->{$el}:{} , $func);
        } else {
            unless ($copy->{$el} eq $original->{$el}) {
                &$func($original->{$el}, {}, $func);
            }
        }
    }
}
~