How can updating hash attribute, updates other hash attributes in Perl Moose - perl

Question

Here hash2 attribute is dependent on hash1. infact, hash2 is driven by hash1. for example,
hash1 -> key1 => value1, key2 => value2 etc..
hash2 -> key1 => 6, key2 => 6 etc. it is length(value from hash1, going to hash2)
Tried something like below, but not helpful.
has 'hash1' => (
is => 'rw',
isa => 'HashRef[Str]',
default => sub { {} },
handles => {
map { $_ . '_hash1' => $_ } #hash_delegations
},
);
has 'hash2' => (
is => 'rw',
isa => 'HashRef',
builder => '_filter_hash1',
handles => {
map { $_ . 'hash2' => $_ } #hash_delegations
},
);
sub _filter_hash1 {
my $self = shift;
for my $alias ($self->keys_hash1()) {
return {$alias, length($alias)};
}
}
Hash1 is going to set over time, not sure how to make sure that how should I capture the event on hash1 to update the entry in the hash2. Any idea how can I achieve this ?

Answer 1

Are you trying to create a cache of value lengths? In practice, length is so fast you don't need to cache it, but it might be just a simplified example of something more complex. I'd use a trigger, plus a trait on the first hash to enforce setting the value via a method. Changing the hash value directly wouldn't trigger the change in the other attribute.
#!/usr/bin/perl
use warnings;
use strict;
use feature qw{ say };
{ package My::Object;
use Moose;
my #hash_delegations = qw( keys );
has 'hash1' => (
is => 'rw',
isa => 'HashRef[Str]',
default => sub { {} },
trigger => \&_update_hash2,
traits => ['Hash'],
handles => { set_hash1 => 'set' },
);
has 'hash2' => (
is => 'ro',
writer => '_set_hash2',
isa => 'HashRef',
);
sub _update_hash2 {
my ($self, $new, $old) = #_;
$self->_set_hash2({ map { $_ => length $self->hash1->{$_} }
keys %{ $self->hash1 }});
}
}
my $o = 'My::Object'->new(hash1 => {a => 42, b => 'Universe'});
say $o->hash2->{$_} for qw( a b );
$o->set_hash1(c => '0123456789');
say $o->hash2->{c};
$o->hash1->{c} = ""; # Wrong!
say $o->hash2->{c}; # Didn't change :-(

Answer 2

Here's an example which uses read-only hashes with triggers and method modifiers...
package MyApp;
use Z qw( Dumper );
use Hash::Util qw( unlock_ref_keys lock_ref_keys );
class '::My::Object' => sub {
my %common = (
is => 'rw',
isa => HashRef[Str],
trigger => sub { lock_ref_keys($_[1]) },
default => sub { lock_ref_keys(my $ref = {}); $ref },
handles_via => 'Hash',
);
has hash1 => (
%common,
handles => [
'set_hash1' => 'set',
'get_hash1' => 'get',
],
);
has hash2 => (
%common,
isa => HashRef[Int],
handles => [
'set_hash2' => 'set',
'get_hash2' => 'get',
],
);
around set_hash1 => sub {
my ( $next, $self, $key, $val ) = ( shift, shift, #_ );
unlock_ref_keys( $self->hash1 );
unlock_ref_keys( $self->hash2 );
my $r = $self->$next( #_ );
$self->set_hash2( $key, length($val) );
lock_ref_keys( $self->hash1 );
lock_ref_keys( $self->hash2 );
return $r;
};
method BUILD => sub {
my ( $self, $args ) = #_;
if ( my $h1 = $args->{hash1} ) {
$self->set_hash1( $_, length $h1->{$_} ) for keys %$h1;
}
};
};
my $obj = 'My::Object'->new(
hash1 => { foo => 'xyzzy' },
);
$obj->set_hash1('bar', 'quux');
print Dumper($obj);