【问题标题】:How can updating hash attribute, updates other hash attributes in Perl Moose如何更新哈希属性,更新 Perl Moose 中的其他哈希属性
【发布时间】:2021-01-22 02:29:44
【问题描述】:

这里的hash2属性依赖于hash1。事实上,hash2 是由 hash1 驱动的。例如,

hash1 -> key1 => value1, key2 => value2 等等。

hash2 -> key1 => 6, key2 => 6 etc. 它是长度(来自 hash1 的值,去 hash2)

尝试了以下类似的方法,但没有帮助。

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 将随着时间的推移设置,不确定如何确保我应该如何捕获 hash1 上的事件以更新 hash2 中的条目。知道如何实现这一目标吗?

【问题讨论】:

    标签: perl moose


    【解决方案1】:

    您是否尝试创建值长度缓存?在实践中,length 非常快,您不需要缓存它,但它可能只是更复杂事物的简化示例。我会使用触发器,加上第一个哈希的特征来强制通过方法设置值。直接更改哈希值不会触发其他属性的更改。

    #!/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 :-(
    

    【讨论】:

      【解决方案2】:

      这是一个使用带有触发器和方法修饰符的只读哈希的示例...

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

      【讨论】:

        猜你喜欢
        • 2011-03-16
        • 1970-01-01
        • 2012-03-11
        • 2014-04-13
        • 1970-01-01
        • 1970-01-01
        • 1970-01-01
        • 1970-01-01
        • 1970-01-01
        相关资源
        最近更新 更多