5

假设我有一个包含一堆基于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 ( source ) 使用的方法:

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 ...
4

3 回答 3

7

我可能会因此而大发雷霆,但如有疑问,请撒谎:)

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

让我们保守这个小秘密,好吗?:)

于 2012-04-23T18:39:57.830 回答
3

如前所述,您不应该直接调用其他扩展的init_meta方法。相反,您应该基本上内联这些扩展的init_meta方法:将所有这些方法的功能组合到您自己的init_meta. 这是脆弱的,因为现在您将模块与其他模块的内部联系在一起,这些内部随时可能发生变化。

例如结合MooseX::HasDefaults::IsROMooseX::StrictConstructorMooseX:: 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
于 2012-04-18T19:54:21.127 回答
1

只要您要使用的 MooseX 都表现良好并使用Moose::Exporter,您就可以使用 Moose::Exporter 为您创建一个行为类似于 Moose 的包:

package MyMoose;

use strict;
use warnings;

use Moose::Exporter;
use MooseX::One ();
use MooseX::Two ();

Moose::Exporter->setup_import_methods(
    also => [ qw{ Moose MooseX::One MooseX::Two } ],
);

1;

请注意,我们还使用 Moose 扩展使用 Moose::Exporter 的包的名称(通常是扩展的主包),而不是使用任何特征应用程序位。Moose::Exporter 在幕后处理所有这些。

这里的优势?一切都按预期工作,所有来自 Moose 和扩展的糖都已安装,并且可以通过“no MyMoose;”删除。

我应该在这里指出,一些扩展与其他扩展不能很好地配合,通常是因为它们没有预料到它们将被要求与其他扩展和谐共存。幸运的是,这些变得越来越少见。

对于更大规模的示例,请查看CPAN 上的Reindeer,它收集了几个扩展并以连贯一致的方式将它们集成在一起。

于 2012-04-25T00:31:15.270 回答