4

我当然知道我可以通过设置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但我仍然不确定它实际上是如何被调用的，因为在我的测试代码中，我的周围实际上并没有被执行。

update munging inBUILDARGS并不是一个真正的选项，因为我正在尝试做的事情是允许通过我通过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块永远不会被运行，我不知道为什么，也许我把它包装在错误的地方或什么地方。

4

3 回答 3

5

我可能是错的，但我认为您可以使用BUILDARGS 方法完成我认为您正在尝试做的事情。这使您可以在构造函数参数用于创建对象之前对其进行调整。

#!/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";
于 2012-04-07T03:50:07.407 回答
4

MooseX::Aliases有几个活动部分来实现此功能，这是因为该行为需要应用于 MOP 中的多个不同位置。您的代码在这里看起来非常接近MooseX::Aliases's Trait 属性中的代码。

我怀疑你的代码没有被调用的原因是当你尝试注册你的特征时出现问题。MooseX::Aliases使用Moose::Util::meta_attribute_alias而不是您在这里使用的老式方式。尝试用对角色内部Moose::Meta::Attribute::Custom::Trait::OtherName的调用替换您的部分。Moose::Util::meta_attribute_alias 'OtherName';

其次，您在此处的代码不适用于不可变类。您需要添加第二个特征来处理这些，因为不变性代码由类的元类而不是属性的元类处理。我认为您还需要添加更多特征来处理角色中的属性。然后您需要连接 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 中的元编程非常强大，但是因为有很多活动部件（其中许多只与最大化性能有关），所以当你深入研究时，你会吃掉很多工作。

祝你好运。

于 2012-04-11T06:37:41.623 回答
0

所以我听到的是：

  • 在构造时，一个属性应该能够通过它的 init_arg 和该属性上定义的任何备用 init_args 来设置。
  • 除非在实例构造中，否则属性不应被其备用 init_args 操作；也就是说，除了上述之外，该属性应该表现得“正常”。

基于此，这似乎很适合MooseX::MultiInitArg属性特征。是的？:)

于 2012-04-12T17:26:25.447 回答