假设我有一堆基于Moose的类的代码库,我希望它们都使用一组通用的MooseX ::*扩展模块.但我不希望每个基于Moose的课程都必须像这样开始:
package My::Class;
use Moose;
use MooseX::Aliases;
use MooseX::HasDefaults::RO;
use MooseX::StrictConstructor;
...
相反,我希望每个类都像这样开始:
package MyClass;
use My::Moose;
并使它完全等同于上述.
我实现这一点的第一次尝试是基于Mason :: Moose使用的方法(来源):
package My::Moose;
use Moose;
use Moose::Exporter;
use MooseX::Aliases();
use MooseX::StrictConstructor();
use MooseX::HasDefaults::RO();
use Moose::Util::MetaRole;
Moose::Exporter->setup_import_methods(also => [ 'Moose' ]);
sub init_meta {
my $class = shift;
my %params = @_;
my $for_class = $params{for_class};
Moose->init_meta(@_);
MooseX::Aliases->init_meta(@_);
MooseX::StrictConstructor->init_meta(@_);
MooseX::HasDefaults::RO->init_meta(@_);
return $for_class->meta();
}
但irc.perl.org上的#moose IRC频道的人们并不推荐这种方法,并且它并不总是有效,具体取决于MooseX::*模块的组合.例如,尝试使用My::Moose上面的类来做My::Class这样的:
package My::Class;
use My::Moose;
has foo => (isa => 'Str');
加载类时导致以下错误:
Attribute (foo) of class My::Class has no associated methods (did you mean to provide an "is" argument?)
at /usr/local/lib/perl5/site_perl/5.12.1/darwin-2level/Moose/Meta/Attribute.pm line 1020.
Moose::Meta::Attribute::_check_associated_methods('Moose::Meta::Class::__ANON__::SERIAL::2=HASH(0x100bd6f00)') called at /usr/local/lib/perl5/site_perl/5.12.1/darwin-2level/Moose/Meta/Class.pm line 573
Moose::Meta::Class::add_attribute('Moose::Meta::Class::__ANON__::SERIAL::1=HASH(0x100be2f10)', 'foo', 'isa', 'Str', 'definition_context', 'HASH(0x100bd2eb8)') called at /usr/local/lib/perl5/site_perl/5.12.1/darwin-2level/Moose.pm line 79
Moose::has('Moose::Meta::Class::__ANON__::SERIAL::1=HASH(0x100be2f10)', 'foo', 'isa', 'Str') called at /usr/local/lib/perl5/site_perl/5.12.1/darwin-2level/Moose/Exporter.pm line 370
Moose::has('foo', 'isa', 'Str') called at lib/My/Class.pm line 5
require My/Class.pm called at t.pl line 1
main::BEGIN() called at lib/My/Class.pm line 0
eval {...} called at lib/My/Class.pm line 0
该MooseX :: HasDefaults :: RO应避免这个错误,但它显然没有被要求做的工作.评论该MooseX::Aliases->init_meta(@_);行"修复"了这个问题,但是a)这是我想要使用的模块之一,以及b)只是进一步强调了这个解决方案的错误.(特别是,init_meta()应该只调用一次.)
所以,我愿意接受建议,完全无视我未能成功实施的建议.只要给出本问题开头所述的结果,任何策略都是受欢迎的.
根据@Ether的答案,我现在有以下内容(也不起作用):
package My::Moose;
use Moose();
use Moose::Exporter;
use MooseX::Aliases();
use MooseX::StrictConstructor();
use MooseX::HasDefaults::RO();
my %class_metaroles = (
class => [
'MooseX::StrictConstructor::Trait::Class',
],
attribute => [
'MooseX::Aliases::Meta::Trait::Attribute',
'MooseX::HasDefaults::Meta::IsRO',
],
);
my %role_metaroles = (
role =>
[ 'MooseX::Aliases::Meta::Trait::Role' ],
application_to_class =>
[ 'MooseX::Aliases::Meta::Trait::Role::ApplicationToClass' ],
application_to_role =>
[ 'MooseX::Aliases::Meta::Trait::Role::ApplicationToRole' ],
);
if (Moose->VERSION >= 1.9900) {
push(@{$class_metaroles{class}},
'MooseX::Aliases::Meta::Trait::Class');
push(@{$role_metaroles{applied_attribute}},
'MooseX::Aliases::Meta::Trait::Attribute',
'MooseX::HasDefaults::Meta::IsRO');
}
else {
push(@{$class_metaroles{constructor}},
'MooseX::StrictConstructor::Trait::Method::Constructor',
'MooseX::Aliases::Meta::Trait::Constructor');
}
*alias = \&MooseX::Aliases::alias;
Moose::Exporter->setup_import_methods(
also => [ 'Moose' ],
with_meta => ['alias'],
class_metaroles => \%class_metaroles,
role_metaroles => \%role_metaroles,
);
使用这样的示例类:
package My::Class;
use My::Moose;
has foo => (isa => 'Str');
我收到此错误:
Attribute (foo) of class My::Class has no associated methods (did you mean to provide an "is" argument?) at ...
使用这样的示例类:
package My::Class;
use My::Moose;
has foo => (isa => 'Str', alias => 'bar');
我收到此错误:
Found unknown argument(s) passed to 'foo' attribute constructor in 'Moose::Meta::Attribute': alias at ...
我可能因此而对煤炭进行倾斜,但如果有疑问,请说谎:)
package MyMoose;
use strict;
use warnings;
use Carp 'confess';
sub import {
my $caller = caller;
eval <<"END" or confess("Loading MyMoose failed: $@");
package $caller;
use Moose;
use MooseX::StrictConstructor;
use MooseX::FollowPBP;
1;
END
}
1;
通过这样做,您将use语句评估到调用包中.换句话说,你向他们撒谎说他们使用的是什么课程.
在这里你宣布你的人:
package MyPerson;
use MyMoose;
has first_name => ( is => 'ro', required => 1 );
has last_name => ( is => 'rw', required => 1 );
1;
并测试!
use lib 'lib';
use MyPerson;
use Test::Most;
throws_ok { MyPerson->new( first_name => 'Bob' ) }
qr/\QAttribute (last_name) is required/,
'Required attributes should be required';
throws_ok {
MyPerson->new(
first_name => 'Billy',
last_name => 'Bob',
what => '?',
);
}
qr/\Qunknown attribute(s) init_arg passed to the constructor: what/,
'... and unknown keys should throw an error';
my $person;
lives_ok { $person = MyPerson->new( first_name => 'Billy', last_name => 'Bob' ) }
'Calling the constructor with valid arguments should succeed';
isa_ok $person, 'MyPerson';
can_ok $person, qw/get_first_name get_last_name set_last_name/;
ok !$person->can("set_first_name"),
'... but we should not be able to set the first name';
done_testing;
测试结果如下:
ok 1 - Required attributes should be required
ok 2 - ... and unknown keys should throw an error
ok 3 - Calling the constructor with valid arguments should succeed
ok 4 - The object isa MyPerson
ok 5 - MyPerson->can(...)
ok 6 - ... but we should not be able to set the first name
1..6
让我们保守这个小秘密,好吗？:)
正如所讨论的，您不应该init_meta直接调用其他扩展的方法。相反，您实际上应该内联这些扩展的init_meta方法：将所有这些方法的功能合并到您自己的init_meta. 这是脆弱的，因为现在您将模块与其他模块的内部结构联系在一起，而这些内部结构随时可能发生变化。
例如，要结合MooseX::HasDefaults::IsRO、MooseX::StrictConstructor和MooseX::Aliases，你会做这样的事情（警告：未经测试）（现已测试！）：
package Mooseish;
use Moose ();
use Moose::Exporter;
use MooseX::StrictConstructor ();
use MooseX::Aliases ();
my %class_metaroles = (
class => ['MooseX::StrictConstructor::Trait::Class'],
attribute => [
'MooseX::Aliases::Meta::Trait::Attribute',
'MooseX::HasDefaults::Meta::IsRO',
],
);
my %role_metaroles = (
role =>
['MooseX::Aliases::Meta::Trait::Role'],
application_to_class =>
['MooseX::Aliases::Meta::Trait::Role::ApplicationToClass'],
application_to_role =>
['MooseX::Aliases::Meta::Trait::Role::ApplicationToRole'],
);
if (Moose->VERSION >= 1.9900) {
push @{$class_metaroles{class}}, 'MooseX::Aliases::Meta::Trait::Class';
push @{$role_metaroles{applied_attribute}}, 'MooseX::Aliases::Meta::Trait::Attribute';
}
else {
push @{$class_metaroles{constructor}},
'MooseX::StrictConstructor::Trait::Method::Constructor',
'MooseX::Aliases::Meta::Trait::Constructor';
}
*alias = \&MooseX::Aliases::alias;
Moose::Exporter->setup_import_methods(
also => ['Moose'],
with_meta => ['alias'],
class_metaroles => \%class_metaroles,
role_metaroles => \%role_metaroles,
);
1;
这可以通过此类和测试进行测试：
package MyObject;
use Mooseish;
sub foo { 1 }
has this => (
isa => 'Str',
alias => 'that',
);
1;
use strict;
use warnings;
use MyObject;
use Test::More;
use Test::Fatal;
like(
exception { MyObject->new(does_not_exist => 1) },
qr/unknown attribute.*does_not_exist/,
'strict constructor behaviour is present',
);
can_ok('MyObject', qw(alias this that has with foo));
my $obj = MyObject->new(this => 'thing');
is($obj->that, 'thing', 'can access attribute by its aliased name');
like(
exception { $obj->this('new value') },
qr/Cannot assign a value to a read-only accessor/,
'attribute defaults to read-only',
);
done_testing;
哪个打印：
ok 1 - strict constructor behaviour is present
ok 2 - MyObject->can(...)
ok 3 - can access attribute by its aliased name
ok 4 - attribute defaults to read-only
1..4