perl - 如何为 Moose 中的属性提供备用初始化参数？

Question

我当然知道我可以通过设置 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 block 永远不会被运行，我不知道为什么，也许我把它包装在错误的地方或什么地方。

Answer 1

我可能是错的，但我认为您可以使用 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";