Use a single module and get Moose plus several MooseX extensions - perl

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

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? :)

As discussed, you shouldn't be calling other extensions' init_meta methods directly. Instead, you should essentially inline those extensions' init_meta methods: combine what all those methods do, into your own init_meta. This is fragile because now you are tying your module to other modules' innards, which are subject to change at any time.
e.g. to combine MooseX::HasDefaults::IsRO, MooseX::StrictConstructor and MooseX::Aliases, you'd do something like this (warning: untested) (now tested!):
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;
This can be tested with this class and tests:
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;
Which prints:
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

So long as the MooseX you want to use are all well-behaved and use Moose::Exporter, you can use Moose::Exporter to create a package that will behave like Moose for you:
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;
Note that in also we're using the name of the package that the Moose extension using Moose::Exporter (generally the main package from the extension), and NOT using any of the trait application bits. Moose::Exporter handles that all behind the scenes.
The advantage here? Everything works as expected, all sugar from Moose and extensions is installed and can be removed via 'no MyMoose;'.
I should point out here that some extensions do not play well with others, usually due to their not anticipating that they'll be required to coexist in harmony with others. Luckily, these are becoming increasingly uncommon.
For a larger scale example, check out Reindeer on the CPAN, which collects several extensions and integrates them together in a coherent, consistent fashion.

Related

Right dynamic class generation using Moose::Meta::Class or Class::MOP::Class

I'd like to implement simple method chaining, for that methods must return objects. Since my code is using Moose already and my future classes are almost empty and return only one attribute with instance of another class I decided to generate them programmatically with Moose::Meta::Class (that is subclass of Class::MOP::Class). First time working with Moose metaclasses so I wrote a simple code to try:
package Cat;
use Moose;
package Generator;
use Moose;
sub generate {
Class::MOP::Class->create(
'Siberian' => (
methods => {
echo => sub { print 'yeah!' }
}
)
);
Class::MOP::Class->create(
'Tiger' => (
attributes => [
Class::MOP::Attribute->new('Siberian' => (
default => sub { require Siberian; Siberian->new; }
)),
],
)
);
Cat->meta->add_attribute(Class::MOP::Attribute->new(
Tiger => (
default => sub { require Tiger; Tiger->new }
)
));
print "Generation done!\n";
}
generate();
package main;
use Generator;
my $a = Cat->new;
warn $a->Tiger->Siberian->echo; # must print 'yeah!' but prints Can't locate object method "new" via package "Tiger" at dynamic.pl line 33
Instead of expected yeah! in output I see
Can't locate object method "new" via package "Tiger" at dynamic.pl
line 33
What is wrong ?
Who will respond to constructor creation?
Another way is using of metaclass variables directly.
https://gist.github.com/akzhan/421579163dfc86f570809f50d239800f

Moose: type libraries (MooseX::Types)

I am trying to figure out the proper way to incorporate Moose in my project. Here I found an article suggesting that Moose types should be organized in type libraries, which seems like a good idea. So I wrote the following code basing on the provided example:
file 1: MyTypeLib.pm
package MyTypeLib;
use MooseX::Types -declare => [ qw( MyStatus ) ];
use MooseX::Types::Moose qw/Int/;
subtype MyStatus,
as Int,
where { $_ >= 0 && $_ < 10 },
message { "Wrong status: $_" };
1;
file 2: MyTest.pm
package MyTest;
use MyTypeLib qw( MyStatus );
use Moose;
has status => ( is => 'rw', isa => 'MyStatus' );
no Moose; 1;
file 3: MyMain.pl
use strict;
use warnings;
use MyTest;
my $t1 = MyTest->new('status' => 5);
When I run it I get this message:
Attribute (status) does not pass the type constraint because:
Validation failed for 'MyStatus' with value 5 (not isa MyStatus) at
C:\Strawberry\perl\vendor\lib\Moose\Object.pm line 24
When I keep subtype definition in MyTest.pm and don't use MooseX::Types, everything works as expected. But the point is to move subtypes to a separate package and use them in other packages.
Could someone please advise how to make it work, or point to (or post) some working example, or suggest the alternative way of achieving the goal.
Thank you!
Remove the quotes: isa => MyStatus, not isa => 'MyStatus'. MyStatus is a constant-like function exported from your type library. Providing a string rather than a proper type constraint for isa ("stringy types") causes it to be looked up in Moose's type registry, or, if it's not found there, it's interpreted as the name of a class, and the type is inferred to be "any object of that class or its subclasses". Stringy types are less explicit and less flexible than using actual types, and more prone to conflicts since they all share a global namespace. It's best not to use them and type lbraries at the same time.
This seems to work
MyTypeLib.pm
package MyTypeLib;
use Moose::Util::TypeConstraints;
subtype MyStatus =>
as 'Num' =>
where { $_ >= 0 && $_ < 10 },
message { "Wrong status: $_" };
#coerce MyStatus => from Int => via { $_ };
1;
MyTest.pm
package MyTest;
use MyTypeLib;
use Moose;
has status => ( is => 'rw',
isa => 'MyStatus',
#coerce => 1 i
);
no Moose; 1;
MyMain.pl
use strict;
use warnings;
use MyTest;
use Data::Dumper;
my $t1 = MyTest->new( status => 5);
print Dumper $t1;
my $t2 = MyTest->new( status => 10);
Which gives
$ perl MyMain.pl
$VAR1 = bless( {
'status' => 5
}, 'MyTest' );
Attribute (status) does not pass the type constraint because: Wrong
status: 10 at /System/Library/Perl/Extras/5.18/darwin-thread-multi-
2level/Moose/Exception.pm line 37
There isn't much information on this aspect of Moose but it looks like Moose::Util::TypeConstraints is the MooseX module folded into Moose.
EDIT
Removed coerce!
You also need an explicit coercion.-

Moo handles => 'Role' not working

For the life of me I can't figure out why this is not working the way the documentation says it should. I have Googled the problem SO searched, looked at the source, etc. Is this a bug or am I doing something wrong that I just can't see.
Here is the code:
#!/usr/bin/env perl
use strict;
use warnings;
package Model;
use Moo::Role;
has ObjectID => (
is => 'rw'
);
package Object;
use Moo;
use namespace::clean;
has model => (
is => 'rw',
handles => 'Model'
);
package main;
my $xo = Object->new;
$xo->ObjectID(12345);
exit;
attempt to run
perl -MCarp::Always t/moohandles.t
and get this
Attempted to access 'model' but it is not set at (eval 26) line 20.
Object::_assert_model('Object=HASH(0x1dfd118)') called at (eval 25) line 17
Object::ObjectID('Object=HASH(0x1dfd118)', 12345) called at t/moohandles.t line 27
Delegation essentially expands the $xo->ObjectID method call to $xo->model->ObjectID. But $xo->model is currently unset. You probably want to default it to an object that consumes the Model role.
Something like this:
use strict;
use warnings;
{
package Model;
use Moo::Role;
has ObjectID => (
is => 'rw',
);
}
{
package ModelClass;
use Moo;
with 'Model';
}
{
package Object;
use Moo;
has model => (
is => 'rw',
handles => 'Model',
builder => sub { ModelClass->new },
);
}
my $xo = Object->new;
$xo->ObjectID(12345);
print $xo->ObjectID, "\n";

Attribute accessor not satisfying role requirement when using Moops and Moose

Consider the following code sample:
use Moops;
role RoleA
using Moose {
requires 'm1';
method m2() {
$self->m1." World!\n";
}
}
role RoleB
using Moose {
has 'm1' => ( accessor => 'm1', is => 'ro', isa => 'Str', default => 'Hello');
}
class ClassA
with RoleB
with RoleA
using Moose {
method m3() {
$self->m2();
}
}
print ClassA->new()->m3();
"Compilation" fails, because the attribute accessor does not seem to satisfy the roles request for m1:
$ perl roletest.pl
'RoleB|RoleA' requires the method 'm1' to be implemented by 'ClassA' at /usr/lib/perl5/site_perl/Moose/Meta/Role/Application/ToClass.pm line 134.
Moose::Meta::Role::Application::ToClass::check_required_methods('Moose::Meta::Role::Application::ToClass=HASH(0x28b9d00)', 'Moose::Meta::Role::Composite=HASH(0x28c6270)', 'Moose::Meta::Class=HASH(0x28ee7c0)') called at /usr/lib/perl5/site_perl/Moose/Meta/Role/Application.pm line 55
Moose::Meta::Role::Application::apply('Moose::Meta::Role::Application::ToClass=HASH(0x28b9d00)', 'Moose::Meta::Role::Composite=HASH(0x28c6270)', 'Moose::Meta::Class=HASH(0x28ee7c0)') called at /usr/lib/perl5/site_perl/Moose/Meta/Role/Application/ToClass.pm line 36
Moose::Meta::Role::Application::ToClass::apply('Moose::Meta::Role::Application::ToClass=HASH(0x28b9d00)', 'Moose::Meta::Role::Composite=HASH(0x28c6270)', 'Moose::Meta::Class=HASH(0x28ee7c0)', 'HASH(0x28e3410)') called at /usr/lib/perl5/site_perl/Moose/Meta/Role.pm line 470
Moose::Meta::Role::apply('Moose::Meta::Role::Composite=HASH(0x28c6270)', 'Moose::Meta::Class=HASH(0x28ee7c0)') called at /usr/lib/perl5/site_perl/Moose/Util.pm line 163
Moose::Util::_apply_all_roles('Moose::Meta::Class=HASH(0x28ee7c0)', undef, 'RoleB', 'RoleA') called at /usr/lib/perl5/site_perl/Moose/Util.pm line 99
Moose::Util::apply_all_roles('Moose::Meta::Class=HASH(0x28ee7c0)', 'RoleB', 'RoleA') called at /usr/lib/perl5/site_perl/Moose.pm line 66
Moose::with('Moose::Meta::Class=HASH(0x28ee7c0)', 'RoleB', 'RoleA') called at /usr/lib/perl5/site_perl/Moose/Exporter.pm line 409
Moose::with('RoleB', 'RoleA') called at roletest.pl line 16
main::BEGIN() called at roletest.pl line 23
eval {...} called at roletest.pl line 23
BEGIN failed--compilation aborted at roletest.pl line 23.
Using plain Moose and Moose::Role this works (as is documented here). Also, not using the Moose backend works to.
I already tried switching the order of the with statements to no avail. Replacing the attribute with a method declaration solves the problem, but I need a way to specify attribute requirements.
Is there a way to get this working?
Are you sure it works with plain Moose? Because I've tried this and it fails with a very similar error message:
use v5.14;
use strict;
use warnings;
package RoleA {
use Moose::Role;
requires 'm1';
sub m2 {
my $self = shift;
$self->m1." World!\n";
}
}
package RoleB {
use Moose::Role;
has 'm1' => ( accessor => 'm1', is => 'ro', isa => 'Str', default => 'Hello');
}
package ClassA {
use Moose;
with qw/ RoleB RoleA /;
sub m3 {
my $self = shift;
$self->m2();
}
}
print ClassA->new()->m3();
There are a number of issues in Moose (and corresponding TODO test cases in the test suite) revolving around attributes in roles not satisfying requires in other roles. For example, bug RT#77406 is similar (though not identical).
UPDATE by manually composing the roles one-at-a-time, in a particular order, you can make it work:
use Moops;
role RoleA using Moose {
requires 'm1';
method m2() {
$self->m1." World!\n";
}
}
role RoleB using Moose {
has 'm1' => ( is => 'ro', isa => 'Str', default => 'Hello' );
}
class ClassA using Moose {
with 'RoleB';
with 'RoleA';
method m3() {
$self->m2();
}
}
print ClassA->new()->m3();

perl moose triggers in subclasses disrupt method modifiers

I've found that if a subclass adds a trigger, then method modifiers from the base class don't run. This seems like a Moose bug, or at least non-intuitive. Here's my example:
package Foo {
use Moose;
has 'foo' => (
is => 'rw',
isa => 'Str',
);
before 'foo' => sub {
warn "before foo";
};
};
package FooChild {
use Moose;
extends 'Foo';
has '+foo' => ( trigger => \&my_trigger, );
sub my_trigger {
warn 'this is my_trigger';
}
};
my $fc = FooChild->new();
$fc->foo(10);
If you run this example, only the "this is my_trigger" warn runs, and the "before" modifier is ignored. I'm using Perl 5.14.2 with Moose 2.0402.
Is this correct behavior? It doesn't seem right, especially since the trigger will fire after the before when the trigger is defined directly in the base class.
On the principle that you should not be able to distinguish between inherited code and code in the class, I'd call this a bug.
It appears to be a general problem where adding to an attribute removes method modifiers. This code demonstrates your bug without involving triggers.
package Foo {
use Moose;
has 'foo' => (
is => 'rw',
isa => 'Str',
default => 5,
);
before 'foo' => sub {
warn "before foo";
};
};
package FooChild {
use Moose;
extends 'Foo';
has '+foo' => ( default => 99 );
};
my $fc = FooChild->new();
print $fc->foo;
Please report this to the Moose folks.