perl moose triggers in subclasses disrupt method modifiers - perl

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.

Related

Moose how to change the attribute value only when it is $undef?

Now have:
has 'id' => (
is => 'rw',
isa => 'Str',
default => sub { "id" . int(rand(1000))+1 }
);
Works OK, the:
PKG->new(id => 'some'); #the id is "some"
PKG->new() #the id is #id<random_number>
In the next scenario:
my $value = undef;
PKG->new(id => $value);
(of course) got an error:
Attribute (id) does not pass the type constraint because: Validation failed for 'Str' with value undef at /Users/me/perl5/perlbrew/perls/perl-5.16.3/lib/site_perl/5.16.3/darwin-thread-multi-2level/Moose/Exception.pm line 37
The question is:
How to achieve changing the value after it is set to undef (and only when it is $undef)? So,
has 'id' => (
is => 'rw',
isa => 'Str|Undef', #added undef to acceptable Type
default => sub { "id" . int(rand(1000))+1 }
);
Now, it accepting the $undef, but I don't want $undef but want "id" . int(rand(1000))+1. How to change the attribute value after it is set?
The after is called only for the accessors not for constructors. Maybe some weird coercion from Undef to Str - but only for this one attribute?
Ps: using the PKG->new( id => $value // int(rand(10000)) ) is not an acceptable solution. The module should accept the $undef and should silently change it to the random number.
Type::Tiny has as one of its aims to make it easy to add coercions to individual attributes really easy. Here's an example:
use strict;
use warnings;
{
package Local::Test;
use Moose;
use Types::Standard qw( Str Undef );
my $_id_default = sub { "id" . int(rand(1000)+1) };
has id => (
is => 'rw',
isa => Str->plus_coercions(Undef, $_id_default),
default => $_id_default,
coerce => 1,
);
__PACKAGE__->meta->make_immutable;
}
print Local::Test->new(id => 'xyz123')->dump;
print Local::Test->new(id => undef)->dump;
print Local::Test->new->dump;
You could also look at MooseX::UndefTolerant which makes undef values passed to the constructor act as if they were entirely omitted. This won't cover passing undef to accessors though; just constructors.
Here is an alternative, using Moose' BUILD method, which is called after an object is created.
#!/usr/bin/perl
package Test;
use Moose;
has 'id' => (
is => 'rw',
isa => 'Str|Undef',
);
sub BUILD {
my $self = shift;
unless($self->id){
$self->id("id" . (int(rand(1000))+1));
}
}
1;
package Main;
my $test = Test->new(id => undef);
print $test->id; ###Prints random number if id=> undef
More info on BUILD here:
http://metacpan.org/pod/Moose::Manual::Construction#BUILD
#choroba in a comment mentioned about the triggers. Based on this, found a next solution. The trigger is called twice in the case id=>undef, but otherwise it works.
use Modern::Perl;
package My;
use namespace::sweep;
use Moose;
my $_id_default = sub { "id" . int(rand(100_000_000_000)+1) };
my $_check_id = sub { $_[0]->id(&$_id_default) unless $_[1] };
has id => (
is => 'rw',
isa => 'Str|Undef',
default => $_id_default,
trigger => $_check_id,
);
__PACKAGE__->meta->make_immutable;
package main;
say My->new->id;
say My->new(id=>'aaa')->id;
say My->new(id=>undef)->id;

Moose method modifiers in base class don't get called

It's cool that it's possible to add them in sub classes or mix them in in roles. My problem is that it seems method modifiers from the base class get deactivated when subclasses redefine the method itself (not the modifier). Maybe I'm understanding method modifiers wrong. Example:
use feature 'say';
package Foo;
use Moose;
has called => (is => 'rw', isa => 'Bool', default => 0);
sub call { 'Foo called' }
after call => sub { shift->called(1) };
my $foo = Foo->new();
say $foo->called; # 0
say $foo->call; # Foo called
say $foo->called; # 1
package Bar;
use Moose;
extends 'Foo';
sub call { 'Bar called' }
my $bar = Bar->new();
say $bar->called; # 0
say $bar->call; # Bar called
say $bar->called; # 0
I expected the last output to be 1 like with $foo. What am I doing wrong?
What happens is this
you define a Foo::call
you modify that with after
you define a Bar::call that doesn't call Foo::Call
The modifiers are not magical runtime things, but class-definition time things. To do what you try to do here you'd have to structure your code differently
#RobEarl posted a link to a very similar question. The solution posted over there was to use augment and although it looks a bit strange and its use is controversial, it could solve my problem:
package Foo;
use Moose;
has called => (is => 'rw', isa => 'Bool', default => 0);
sub call { inner(); shift->called(1); 'Foo called' }
package Bar;
use Moose;
extends 'Foo';
augment call => sub { 'Bar called' };
my $bar = Bar->new();
say $bar->called; # 0
say $bar->call; # Bar called
say $bar->called; # 1

Moose Role Derivation

I would like to now what is the better pattern to do what I need. I try to reduce the problem to a minimum, let me explain it step by step.
I have an interface Role like:
{
package Likeable;
use Moose::Role;
requires 'likers';
requires 'do_like';
}
After this, I need 2 Abstract Roles that semi-implement the previous interface (in this case they implement all):
{
package Likeable::OnSelf;
use Moose::Role;
with 'Likeable';
has 'likers' => ( is => 'rw', isa => 'ArrayRef' );
sub do_like { }
}
{
package Likeable::OnParent;
use Moose::Role;
with 'Likeable';
requires 'parent';
sub likers { shift->parent->likers(#_) }
sub do_like { shift->parent->do_like(#_) }
}
and later I need this code to compile
{
package OBJ::OnSelf;
use Moose;
with 'Likeable::OnSelf';
}
{
package OBJ::OnParent;
use Moose;
with 'Likeable::OnParent';
has 'parent' => ( is => 'rw', isa => 'Obj' );
}
foreach my $obj (OBJ::OnSelf->new, OBJ::OnParent->new(parent => OBJ::OnSelf->new)) {
if ( $obj->does('Likeable') ) {
$obj->do_like
}
}
The problem seems to me that is that I'm trying to do derivation on the Moose::Role, but I have no ideia how to solve the problem correctly.
May I have your suggestions?
There's no problem really with your overall role composition, but I assume you are getting an error like this:
'Likeable::OnParent' requires the method 'parent' to be implemented by 'OBJ::OnParent' at .../Moose/Meta/Role/Application.pm line 51
The problem is that has is called to create the attribute accesssor method after with is called to check for the method. (These are just subroutines being called, not actual language constructs.)
There are couple good solutions I know of. I prefer this one:
package OBJ::OnParent;
use Moose;
has 'parent' => ( is => 'rw', isa => 'Obj' );
with 'Likeable::OnParent';
Do your with statement after the attribute(s) are defined. The other option I know of is this:
package OBJ::OnParent;
use Moose;
with 'Likeable::OnParent';
BEGIN {
has 'parent' => ( is => 'rw', isa => 'Obj' );
}
By placing your has calls in a BEGIN block, the attributes are added to the package just after use Moose is run and before with. I don't like sticking in BEGIN blocks like this, but that's mostly a personal preference.
In this particular case, though, I might suggest just changing Likeable::OnParent to such that you better specify that the parent method returns a Likeable, which will also bypass the need to change your object definitions:
package Likeable::OnParent;
use Moose::Role;
with 'Likeable';
has parent => (
is => 'rw',
does => 'Likeable',
required => 1,
);
sub likers { shift->parent->likers(#_) }
sub do_like { shift->parent->do_like(#_) }
This way you have confidence that your calls to likers and do_like will succeed because the attribute must be set and it must implement the role that requires those methods and the documented contract.

Use a single module and get Moose plus several MooseX extensions

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.

Moose: Loading object from file in the BUILD method

I have to read a file in the BUILD method and I want to use the load method of the MooseX::Storage package.
But this load method create a new object and so when I instatiate the object this isn’t the object read from file. In the code below I create an object $m1 with state 2 to write the file, I create $m2 with no parameter to read the file but $m2 doesn’t contain the right value.
The package:
package mia;
use Moose;
use MooseX::Storage;
with Storage(format => 'JSON', io => 'File');
has 'nome' => ( is => 'rw', isa => 'Str', default =>'',);
has 'stato' => ( is => 'rw', isa => 'Int', default =>1,);
sub BUILD {
my $self=shift;
if ($self->stato==1){
$self=mia->load("mia.dat");
}
if ($self->stato==2){
$self->stato(0);
$self->nome("prova");
$self->store("mia.dat");
}
}
sub stampa(){
my $self=shift;
print $self->nome." ".$self->stato;
}
the main program
use mia;
my $m;
$m1=mia->new(stato=>2);
$m2=mia->new();
print "\nm1 \n";
$m1->stampa();
print "\nm2 \n";
$m2->stampa();
Your code seems to be acting as if BUILD is a constructor, which it isn't -- it's more like a post-construction hook where you can perform other things like read values from a DB. You should instead either:
store the result of mia->load in an attribute, and optionally use delegated methods to access it, or
use the result of mia->load as the object, rather than constructing a separate one.
Here is an example of the first case, separating the MooseX::Storage object from the object that controls it:
package miaController;
use Moose;
use mia;
has 'nome' => ( is => 'rw', isa => 'Str', default =>'',);
has 'stato' => ( is => 'rw', isa => 'Int', default =>1,);
has 'mia' => ( is => 'rw', isa => 'mia', lazy => 1);
sub BUILD
{
my $self = shift;
if ($self->stato == 1)
{
$self->mia(mia->load("mia.dat"));
}
elsif ($self->stato == 2)
{
$self->stato(0);
$self->nome("prova");
$self->mia->store("mia.dat");
}
}
sub stampa
{
my $self = shift;
print $self->nome." ".$self->stato;
}
package mia;
use Moose;
use MooseX::Storage;
with Storage(format => 'JSON', io => 'File');
package main:
use miaController;
my $m1=miaController->new(stato=>2);
my $m2=miaController->new();
print "\nm1 \n";
$m1->stampa();
print "\nm2 \n";
$m2->stampa();