Как посмотреть конкретный хеш-ключ для изменения его значения? - PullRequest
Новая
       26

Как посмотреть конкретный хеш-ключ для изменения его значения?

0 голосов
/ 13 февраля 2019

У меня есть хеш, например $hash->{'foo'}{'bar'}.

Я хочу позвонить Carp::cluck в любое место, где изменилось значение клавиши bar.

Как это сделать?Есть ли готовый модуль на CPAN, который может сделать этот трюк?

Ответы [ 3 ]

0 голосов
/ 13 февраля 2019

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(@_);
    }
};
...
0 голосов
/ 14 февраля 2019

Я сделал «простую» функцию для этого, она не работает с хешами, которые содержат массивы: 

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);
            }
        }
    }
}
~
0 голосов
/ 13 февраля 2019 
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.)

...