perlmoose

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


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 ?


Solution

  • 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);