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) それは私が使用したいモジュールの 1 つであり、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::Exporter (通常は拡張機能のメイン パッケージ) を使用する Moose 拡張機能のパッケージの名前を使用しており、トレイト アプリケーション ビットは使用していないことに注意してください。Moose::Exporter は、そのすべてを舞台裏で処理します。

ここの利点?すべてが期待どおりに機能し、Moose と拡張機能からのすべてのシュガーがインストールされ、'no MyMoose;' で削除できます。

ここで指摘しておきたいのは、一部の拡張機能は他の拡張機能とうまく機能しないということです。これは通常、他の拡張機能と調和して共存する必要があることを予測していないためです。幸いなことに、これらはますます珍しくなっています。

より大規模な例については、CPAN のReindeerを調べてください。これは、いくつかの拡張機能を収集し、それらを首尾一貫した方法で統合しています。

于 2012-04-25T00:31:15.270 に答える