如何为Moose中的属性提供备用init arg?

时间:2012-04-07 02:14:54

标签: perl moose

我当然知道我可以通过设置init_arg(例如)

来重命名属性的init arg
package Test {
    use Moose;
    has attr => (
       is => 'ro',
       isa => 'Str',
       init_arg => 'attribute'
    );
}

这将允许我

Test->new({ attribute => 'foo' });

但不是

Test->new({ attr => 'foo' });

同时

MooseX::Aliases实际上有此行为,但创建别名也会创建访问者。我目前正在尝试理解该模块中的代码,看看我是否无法确定它是如何做到的,以便我可以复制所述功能(以我理解的方式)。如果有人可以通过一个很棒的例子来解释如何做到这一点。

更新看来MX :: Aliases是通过替换around initialize_instance_slot中实际传递给构造函数的方式来实现的,但是我仍然不确定它是如何实际调用的,因为在我的测试代码中,我的实际上并没有被执行。

更新BUILDARGS中进行修改并不是一个真正的选项,因为我尝试做的是允许通过标签的名称设置访问者我通过Meta Recipe3添加了该属性。你可能会说我在做

has attr => (
   is => 'ro',
   isa => 'Str',
   alt_init_arg => 'attribute'
);

更新

这就是我到目前为止所做的工作。

use 5.014;
use warnings;

package MooseX::Meta::Attribute::Trait::OtherName {
    use Moose::Role;
    use Carp;

    has other_name => (
        isa       => 'Str',
        predicate => 'has_other_name',
        required  => 1,
        is        => 'ro',
    );

    around initialize_instance_slot => sub {
        my $orig = shift;
        my $self = shift;

        my ( $meta_instance, $instance, $params ) = @_;

        confess 'actually calling this code';

        return $self->$orig(@_)
            unless $self->has_other_name && $self->has_init_arg;

        if ( $self->has_other_name ) {
            $params->{ $self->init_arg }
                = delete $params->{ $self->other_name };
        }
    };
}

package Moose::Meta::Attribute::Custom::Trait::OtherName {
    sub register_implementation { 'MooseX::Meta::Attribute::Trait::OtherName' }
}

package Message {
    use Moose;
#   use MooseX::StrictConstructor;

    has attr => (
        traits    => [ 'OtherName' ],
        is        => 'ro',
        isa       => 'Str',
        other_name => 'Attr',
    );

    __PACKAGE__->meta->make_immutable;
}

package Client {
    use Moose;

    sub serialize {
        my ( $self, $message ) = @_;

        confess 'no message' unless defined $message;

        my %h;
        foreach my $attr ( $message->meta->get_all_attributes ) {
            if (
                    $attr->does('MooseX::Meta::Attribute::Trait::OtherName')
                    && $attr->has_other_name
                ) {
                $h{$attr->other_name} = $attr->get_value( $message );
            }
        }
        return \%h;
    }
    __PACKAGE__->meta->make_immutable;
}

my $message = Message->new( Attr => 'foo' );

my $ua = Client->new;

my %h = %{ $ua->serialize( $message )};

use Data::Dumper::Concise;

say Dumper \%h

问题是我的around块永远不会被运行,我不知道为什么,也许我把它包装在错误的地方或什么的。

3 个答案:

答案 0 :(得分:3)

我可能错了,但我认为您可以使用BUILDARGS method完成我认为您尝试做的事情。这使得您可以在使用构造函数参数创建对象之前对其进行处理。

#!/usr/bin/env perl

use strict;
use warnings;

{
  package MyClass;

  use Moose;
  has attr => (
     is => 'ro',
     isa => 'Str',
     required => 1,
  );

  around BUILDARGS => sub {
    my $orig = shift;
    my $self = shift;
    my %args = ref $_[0] ? %{shift()} : @_;

    if (exists $args{attribute}) {
      $args{attr} = delete $args{attribute};
    }

    $self->$orig(%args);
  };
}

my $one = MyClass->new(attribute => "Hi");
my $two = MyClass->new(attr => "Bye");

print $one->attr, "\n";
print $two->attr, "\n";

答案 1 :(得分:3)

MooseX::Aliases有几个移动部件可以使这个功能发生,这是因为行为需要应用于MOP中的几个不同的地方。这里的代码非常接近MooseX::Aliases的Trait属性中的代码。

我怀疑您的代码未被调用的原因是由于您尝试注册您的特征时出现问题。 MooseX::Aliases使用Moose::Util::meta_attribute_alias而不是您在此处使用的旧式方式。尝试通过调用角色中的Moose::Meta::Attribute::Custom::Trait::OtherName来替换Moose::Util::meta_attribute_alias 'OtherName';部分。

其次,此处的代码不适用于不可变类。您需要添加第二个特征来处理这些特性,因为不可变性代码由类的元类而不是属性的元类处理。你还需要添加一些特性来处理Roles中的属性。然后你需要连接一个Moose :: Exporter,以确保在编译完所有内容后正确应用所有特征。

我已经通过不可变的方式得到了一个简单的版本。此代码也在github上。

首先是属性特征:

package MooseX::AltInitArg::Meta::Trait::Attribute;
use Moose::Role;
use namespace::autoclean;
Moose::Util::meta_attribute_alias 'AltInitArg';


has alt_init_arg => (
    is         => 'ro',
    isa        => 'Str',
    predicate  => 'has_alt_init_arg',
);


around initialize_instance_slot => sub {
    my $orig = shift;
    my $self = shift;
    my ($meta_instance, $instance, $params) = @_;

    return $self->$orig(@_)
        # don't run if we haven't set any alt_init_args
        # don't run if init_arg is explicitly undef
        unless $self->has_alt_init_arg && $self->has_init_arg;

    if (my @alternates = grep { exists $params->{$_} } ($self->alt_init_arg)) {
        if (exists $params->{ $self->init_arg }) {
            push @alternates, $self->init_arg;
        }

        $self->associated_class->throw_error(
            'Conflicting init_args: (' . join(', ', @alternates) . ')'
        ) if @alternates > 1;

        $params->{ $self->init_arg } = delete $params->{ $alternates[0] };
    }
    $self->$orig(@_);
};

1;
__END__

接下来的Class特质。

package MooseX::AltInitArg::Meta::Trait::Class;
use Moose::Role;
use namespace::autoclean;

around _inline_slot_initializer => sub {
    my $orig = shift;
    my $self = shift;
    my ($attr, $index) = @_;

    my @orig_source = $self->$orig(@_);
    return @orig_source
        # only run on aliased attributes
        unless $attr->meta->can('does_role')
            && $attr->meta->does_role('MooseX::AltInitArg::Meta::Trait::Attribute');
    return @orig_source
        # don't run if we haven't set any aliases
        # don't run if init_arg is explicitly undef
        unless $attr->has_alt_init_arg && $attr->has_init_arg;

    my $init_arg = $attr->init_arg;

    return (
        'if (my @aliases = grep { exists $params->{$_} } (qw('
          . $attr->alt_init_arg . '))) {',
            'if (exists $params->{' . $init_arg . '}) {',
                'push @aliases, \'' . $init_arg . '\';',
            '}',
            'if (@aliases > 1) {',
                $self->_inline_throw_error(
                    '"Conflicting init_args: (" . join(", ", @aliases) . ")"',
                ) . ';',
            '}',
            '$params->{' . $init_arg . '} = delete $params->{$aliases[0]};',
        '}',
        @orig_source,
    );
};
1;
__END__

最后是Moose::Exporter胶水。

package MooseX::AltInitArg;
use Moose();

use Moose::Exporter;
use MooseX::AltInitArg::Meta::Trait::Attribute;

Moose::Exporter->setup_import_methods(
    class_metaroles => { class => ['MooseX::AltInitArg::Meta::Trait::Class'] }
);

1;
__END__

如何使用它的一个例子:

package MyApp;
use 5.10.1;
use Moose;
use MooseX::AltInitArg;

has foo => (
    is            => 'ro',
    traits        => ['AltInitArg'],
    alt_init_arg => 'bar',
);


my $obj = MyApp->new( bar => 'bar' );
say $obj->foo; # prints bar

Moose中的元编程非常强大,但是因为有很多活动部件(其中许多只与最大化性能有关),所以当你潜入水中时,你会咬掉很多工作。

祝你好运。

答案 2 :(得分:0)

所以我听到的是:

  • 在构建时,应该可以通过其init_arg和属性上定义的任何备用init_args来设置属性。
  • 除了在实例构造中,属性不应该由其备用init_args操纵;也就是说,除了上述内容之外,属性应该表现为“正常”。

基于此,这似乎是MooseX::MultiInitArg属性特征的良好匹配。是? :)