Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Use a single module and get Moose plus several MooseX extensions

Tags:

perl

moose

Let's say I have a codebase with a bunch of Moose-based classes and I want them all to use a common set of MooseX::* extension modules. But I don't want each Moose-based class to have to start like this:

package My::Class;

use Moose;
use MooseX::Aliases;
use MooseX::HasDefaults::RO;
use MooseX::StrictConstructor;
...

Instead, I want each class to begin like this:

package MyClass;

use My::Moose;

and have it be exactly equivalent to the above.

My first attempt at implementing this was based on the approach used by 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();
}

But this approach is not recommended by the folks in the #moose IRC channel on irc.perl.org, and it doesn't always work, depending on the mix of MooseX::* modules. For example, trying to use the My::Moose class above to make My::Class like this:

package My::Class;

use My::Moose;

has foo => (isa => 'Str');

Results in the following error when the class is loaded:

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

The MooseX::HasDefaults::RO should be preventing this error, but it's apparently not being called upon to do its job. Commenting out the MooseX::Aliases->init_meta(@_); line "fixes" the problem, but a) that's one of the modules I want to use, and b) that just further emphasizes the wrongness of this solution. (In particular, init_meta() should only be called once.)

So, I'm open to suggestions, totally ignoring my failed attempt to implement this. Any strategy is welcome as long as if gives the results described at the start of this question.


Based on @Ether's answer, I now have the following (which also doesn't work):

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,
);

With a sample class like this:

package My::Class;

use My::Moose;

has foo => (isa => 'Str');

I get this error:

Attribute (foo) of class My::Class has no associated methods (did you mean to provide an "is" argument?) at ...

With a sample class like this:

package My::Class;

use My::Moose;

has foo => (isa => 'Str', alias => 'bar');

I get this error:

Found unknown argument(s) passed to 'foo' attribute constructor in 'Moose::Meta::Attribute': alias at ...
like image 817
John Siracusa Avatar asked Apr 18 '12 19:04

John Siracusa


1 Answers

I might get raked over the coals for this, but when in doubt, lie :)

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;

By doing that, you're evaling the use statements into the calling package. In other words, you're lying to them about what class they are used in.

And here you declare your person:

package MyPerson;                                                                                                                                                              
use MyMoose;

has first_name => ( is => 'ro', required => 1 );
has last_name  => ( is => 'rw', required => 1 );

1;

And tests!

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;

And the test results:

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

Let's keep this our little secret, shall we? :)

like image 60
Ovid Avatar answered Sep 21 '22 17:09

Ovid