(= =>“rwp”)更改编写器前缀

时间:2015-09-24 14:03:20

标签: perl moo moops

如果我想更改写保护属性,即

use Moops;

class foo {
  has attr => (is => "rwp");
}

必须使用_set_attr()

是否可以在不使用明确_attr()的情况下将其更改为writer

尝试了use MooseX::::AttributeShortcuts -writer_prefix => 'prefix';但是没有用。

1 个答案:

答案 0 :(得分:3)

,您需要自行设置writer

TLDR:无论如何,底部是一个猴子补丁。

Moops docs说(强调我的):

  

Moops在您的类中使用MooseX :: MungeHas,以便使用has关键字   支持一些特定于Moo的功能,即使您正在使用Moose或   老鼠。 具体来说,它支持is => 'rwp' is => 'lazy'builder => 1clearer => 1predicate => 1trigger => 1

现在让我们看看Moo。在文档的has部分,它说(强调我的):

  

rwp代表“读写保护”并生成类似ro的读者,   但也要将作者设置为_set_${attribute_name}以获取属性   旨在从类内部编写,但只读   外。此功能来自MooseX :: AttributeShortcuts。

好的,到MooseX::AttributeShortcuts

  

指定is => 'rwp'将导致设置以下选项:

is     => 'ro'
writer => "_set_$name"

然而,这正是它受到启发的地方。它实际上是在Method::Generate::Accessor 1 中的Moo中实现的。

  } elsif ($is eq 'rwp') {
    $spec->{reader} = $name unless exists $spec->{reader};
    $spec->{writer} = "_set_${name}" unless exists $spec->{writer};
  } elsif ($is ne 'bare') {

更实际上,这也不是在Moops中完成的地方。实际上,这种情况发生在Moops使用的MooseX::MungeHas中,但只有当调用者不是Moo时才会发生:

            push @code, '  if ($_{is} eq q(rwp)) {';
            push @code, '    $_{is}     = "ro";';
            push @code, '    $_{writer} = "_set_$_" unless exists($_{writer});';
            push @code, '  }';

看起来很清楚。它是在生成的代码中。如果只使用Moo,下面的解决方案可能会有效,但我不知道如何强迫它。

你确实可以通过使用Class :: Method :: Modifiers连接到Moo的Method :: Generate :: Accessor并在{{1}中添加一些逻辑来改变Moo中的 }修饰符到around。只要没有涉及Moose的东西,这个不起作用适用于Moops。

generate_method

<强>输出

use Moops;

BEGIN {
  require Method::Generate::Accessor; # so it's in %INC;
  require Class::Method::Modifiers;
  Class::Method::Modifiers::around( 'Method::Generate::Accessor::generate_method' => sub {
    my $orig = shift;

    #      0      1      2      3      4
    #  my ($self, $into, $name, $spec, $quote_opts) = @_;

    if ($_[3]->{is} eq 'rwp') {
      $_[3]->{writer} = "_explicitly_set_$_[2]" unless exists $_[3]->{reader};
    }

    $orig->(@_);
  });
}

class Foo {
    has attr => ( is => "rwp" );
}

use Data::Printer;

my $foo = Foo->new( attr => 1 );
p $foo;

1)我发现使用grep.cpan.me