4

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

我想在键值发生变化Carp::cluck的任何地方打电话bar。

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

4

3 回答 3

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.）

于 2019-02-13T11:39:13.373 回答
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(@_);
    }
};
...
于 2019-02-13T14:22:10.813 回答
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);
            }
        }
    }
}
~
于 2019-02-14T10:08:13.900 回答