init_arg我当然知道我可以通过设置(例如)重命名属性的 init arg
package Test {
use Moose;
has attr => (
is => 'ro',
isa => 'Str',
init_arg => 'attribute'
);
}
Run Code Online (Sandbox Code Playgroud)
这将使我能够
Test->new({ attribute => 'foo' });
Run Code Online (Sandbox Code Playgroud)
但不是
Test->new({ attr => 'foo' });
Run Code Online (Sandbox Code Playgroud)
同时
MooseX::Aliases实际上有这种行为,但创建别名也会创建访问器。我目前正在尝试理解该模块中的代码,看看我是否无法确定它是如何实现的,以便我可以复制所述功能(以我理解的方式)。如果有人可以在这里用一个例子解释如何做到这一点,那就太好了。
更新看起来 MX::Aliases 是通过替换实际传递给构造函数的方式来做到这一点的,around initialize_instance_slot但我仍然不确定它实际上是如何被调用的,因为在我的测试代码中,我的周围实际上并没有被执行。
update munging inBUILDARGS并不是真正的选项,因为我试图做的事情是允许通过我通过Meta Recipe3添加到属性的标签名称来设置访问器。你可能会说我在做
has attr => (
is => 'ro',
isa => 'Str',
alt_init_arg => 'attribute'
);
Run Code Online (Sandbox Code Playgroud)
更新
这是我到目前为止所尝试做的事情。
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
Run Code Online (Sandbox Code Playgroud)
问题是我的around块永远不会运行,我不知道为什么,也许我把它包装在错误的地方或其他什么地方。
我可能是错的,但我认为您可能能够使用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";
Run Code Online (Sandbox Code Playgroud)
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';
其次,您此处的代码不适用于不可变类。您需要添加第二个特征来处理这些问题,因为不变性代码是由类的元类而不是属性的元类处理的。我认为您还需要添加更多特征来处理角色中的属性。然后,您需要连接 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__
Run Code Online (Sandbox Code Playgroud)
接下来是阶级特征。
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__
Run Code Online (Sandbox Code Playgroud)
最后上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__
Run Code Online (Sandbox Code Playgroud)
下面是如何使用它的示例:
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
Run Code Online (Sandbox Code Playgroud)
Moose 中的元编程非常强大,但由于有很多移动部件(其中许多仅与性能最大化有关),因此当您深入研究时,您会付出很多努力。
祝你好运。