Moose - 修改对象哈希中的默认属性位置

Question

我正在处理一些非 Moose 遗留代码，我想用 Moose 类对其进行扩展。这是遗留代码的简化：

package My::Legacy;

sub create {
  my ($class, $args) = @_;

  my $fields = { _fields => {}};
  foreach my $key ( keys %$args ) {
     $fields->{_fields}->{$key} = $args->{$key}
  }
  bless $fields, $class;
}

1;

My::Legacy 类处理所有 CRUD 操作、缓存和其他内容。所有操作都在内部 _field 散列中包含的值上执行，因此，例如，如果您要更新一个值，它必须在 _field 散列中。 My::Legacy 类为此提供了 setter/getter。

My::Legacy 是几个需要它提供的“糖”的类的子类：My::Legacy::ObjectA、My: :Legacy::ObjectB等

我需要再添加一个，并且我想使用 Moose 对其进行扩展。问题是每次设置属性时，我都必须在内部 _fields 哈希中保持其值同步，例如，如果我有...

 package My::Legacy::MyMooseObj;

 use Moose;
 use MooseX::NonMoose;
 use namespace::autoclean;

 has _fields => (
   isa         => HashRef,
   is          => 'rw',
   default     => sub { {} },
 );

 has attr_a => (
   isa   => 'Int',
   is    => 'ro',
 );

 has attr_b => (
   isa   => 'Str',
   is    => 'ro',
 );


 __PACKAGE__->meta->make_immutable;

...我愿意：

 my $MyMooseObj = My::Legacy::MyMooseObj->new();
 $MyMooseObj->attr_a(15);

...我也希望在 _fields 中设置 attr_a，所以如果我转储对象，它会如下所示：

 bless( {
             '_fields' => {
                           'attr_a' => 15,
                         },
             'attr_a' => 15,
           }, 'My::Legacy::MyMooseObj' );

我想达到的方法是为每个属性添加一个触发器，以便在每次设置时将其值写入 _fields 散列：

     has attr_b => (
      isa   => 'Str',
      is    => 'ro',
      trigger => sub { # Write in the _fields attribute attr_b value! },
    );

这有点烦人，因为每次我添加一个新属性时，我都必须确保它设置了触发器：/

你能想出更好的方法吗？有没有办法告诉 Moose 默认读取/写入不在对象哈希的“根”中的属性（所以在我的情况下，从 _fields 读取/写入属性）？

Answer 1

这或多或少可以满足您的需求...

use strict;
use warnings;

{
    package My::Legacy::MyMooseObj;

    use Moose;
    use MooseX::FunkyAttributes;
    use namespace::autoclean;

    has _fields => (
        isa         => 'HashRef',
        is          => 'rw',
        default     => sub { {} },
        lazy        => 1,  # you want this, for the rest to work
    );

    has attr_a => (
        isa         => 'Int',
        is          => 'ro',
        traits      => [ FunkyAttribute ],
        custom_get  => sub { $_->_fields->{attr_a} },
        custom_set  => sub { $_->_fields->{attr_a} = $_[-1] },
        custom_has  => sub { exists($_->_fields->{attr_a}) },
    );

    has attr_b => (
        isa         => 'Str',
        is          => 'rw',
        traits      => [ FunkyAttribute ],
        custom_get  => sub { $_->_fields->{attr_b} },
        custom_set  => sub { $_->_fields->{attr_b} = $_[-1] },
        custom_has  => sub { exists($_->_fields->{attr_b}) },
    );
}

my $obj = My::Legacy::MyMooseObj->new( attr_a => 42 );
$obj->attr_b(666);

print $obj->dump;

使用当前版本的 MooseX::FunkyAttributes，如果您执行整个 __PACKAGE__->meta->make_immutable，构造函数将无法正常工作。 :-(

稍微深入研究元编程...

use strict;
use warnings;

{
    package My::Legacy::MyMooseObj;

    use Moose;
    use MooseX::FunkyAttributes;
    use namespace::autoclean;

    has _fields => (
        isa         => 'HashRef',
        is          => 'rw',
        default     => sub { {} },
        lazy        => 1,  # you want this, for the rest to work
    );

    sub funky_has {
        my ($attr, %opts) = @_;
        has $attr => (
            is          => 'ro',
            traits      => [ FunkyAttribute ],
            custom_get  => sub { $_->_fields->{$attr} },
            custom_set  => sub { $_->_fields->{$attr} = $_[-1] },
            custom_has  => sub { exists($_->_fields->{$attr}) },
            %opts,
        );
    }

    funky_has attr_a => (isa => 'Int');
    funky_has attr_b => (isa => 'Str', is => 'rw');
}

my $obj = My::Legacy::MyMooseObj->new( attr_a => 42 );
$obj->attr_b(666);

print $obj->dump;