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

时间:2014-03-25 13:00:01

标签: perl attributes moose

我正在处理一些非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 我的: :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 读/写属性)?

1 个答案:

答案 0 :(得分: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;