Skip Menu |
 

This queue is for tickets about the Moose CPAN distribution.

Report information
The Basics
Id: 68698
Status: open
Priority: 0/
Queue: Moose

People
Owner: Nobody in particular
Requestors: EALLENIII [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: Important
Broken in: 2.0007
Fixed in: (no value)



Subject: Applying traits to attributes using clone_and_inherit_options fails for traits that overwrite _process_options
Download (untitled) / with headers
text/plain 298b
Several MooseX modules hack the _process_options method for attributes. After trying to figure out why my (evil evil evil) module MooseX::Role::AttributeOverride was failing for these, I found the issue was with Moose. The attached test demonstrates the issue. Thanks (and please forgive me).
Subject: moosetrait.t
Download moosetrait.t
text/x-perl 1.1k
package MyApp::Meta::Attribute; use Moose::Role; around _process_options => sub { my ( $orig, $class, $name, $options ) = @_; $options->{default} = sub { return 'yep' }; return $orig->($class , $name, $options); }; package MyApp; use Moose; has 'fun' => ( is => 'rw', isa => 'Str' ); __PACKAGE__->meta->make_immutable; no Moose; package MyApp::Child; use Moose; extends qw(MyApp); has '+fun' => ( traits => ['MyApp::Meta::Attribute'] ); no Moose::Role; package MyApp::Brother; use Moose; has 'fun' => ( is => 'rw', isa => 'Str', traits => ['MyApp::Meta::Attribute'] ); __PACKAGE__->meta->make_immutable; no Moose; package main; use Test::More tests => 6; # last test to print my $testa = MyApp::Child->new(); my $testb = MyApp::Brother->new(); for my $test ($testa,$testb) { my $attr = $test->meta->find_attribute_by_name('fun'); ok ( $attr->has_applied_traits, 'Traits get applied'); my @good = grep {$_ eq 'MyApp::Meta::Attribute'} @{$attr->applied_traits}; ok (scalar @good, 'My traits get applied'); is( $test->fun, 'yep', "Default was set by role" ); }
Download (untitled) / with headers
text/plain 793b
After reviewing the Moose source for some time, I see no easy fix for this. The problem is that the clone method, reasonably, skips the _process_options method. It would be ideal to pass the options through _process_options from clone_and_inherit_options, but this does not solve the problem. The problem is that the generated metaclass is not the metaclass of the final cloned option until new is ran, where we are back to running _process_options being not a good idea. All the solutions I can think of are even uglier than the current code. I think I am going to implement something that basically rewrites clone_and_inherit_options and runs it through process_options after running interpolate_class, using the returned metaclass instead of $self, if that makes any sense.
Ok. Attached is a patch to 'fix' the issue. It is a horrible hack...
Subject: hackish_fix.patch
Download hackish_fix.patch
text/x-diff 4.3k
diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm index 3b138fa..f574e8d 100644 --- a/lib/Moose/Meta/Attribute.pm +++ b/lib/Moose/Meta/Attribute.pm @@ -198,34 +198,6 @@ sub clone_and_inherit_options { (scalar @found_illegal_options == 0) || $self->throw_error("Illegal inherited options => (" . (join ', ' => @found_illegal_options) . ")", data => \%options); - if ($options{isa}) { - my $type_constraint; - if (blessed($options{isa}) && $options{isa}->isa('Moose::Meta::TypeConstraint')) { - $type_constraint = $options{isa}; - } - else { - $type_constraint = Moose::Util::TypeConstraints::find_or_create_isa_type_constraint($options{isa}); - (defined $type_constraint) - || $self->throw_error("Could not find the type constraint '" . $options{isa} . "'", data => $options{isa}); - } - - $options{type_constraint} = $type_constraint; - } - - if ($options{does}) { - my $type_constraint; - if (blessed($options{does}) && $options{does}->isa('Moose::Meta::TypeConstraint')) { - $type_constraint = $options{does}; - } - else { - $type_constraint = Moose::Util::TypeConstraints::find_or_create_does_type_constraint($options{does}); - (defined $type_constraint) - || $self->throw_error("Could not find the type constraint '" . $options{does} . "'", data => $options{does}); - } - - $options{type_constraint} = $type_constraint; - } - # NOTE: # this doesn't apply to Class::MOP::Attributes, # so we can ignore it for them. @@ -238,10 +210,22 @@ sub clone_and_inherit_options { $options{traits} = \@all_traits if @all_traits; } + + ### This is a hack to make _process_lazy_options work + $options{__hack_is_inherit} = 1; + + ### This is a hack to make _process_options work. + if ($options{coerce} && (! exists $options{isa})) { + $options{isa} = $self->type_constraint; + } + + # This method can be called on a CMOP::Attribute object, so we need to # make sure we can call this method. - $self->_process_lazy_build_option( $self->name, \%options ) - if $self->can('_process_lazy_build_option'); + $options{metaclass}->_process_options( $self->name, \%options ) + if $self->can('_process_options'); + + delete $options{__hack_is_inherit}; $self->clone(%options); } @@ -450,7 +434,9 @@ sub _process_lazy_option { return unless $options->{lazy}; - ( exists $options->{default} || defined $options->{builder} ) + # Added hack to allow lazy on inherit + ( exists $options->{default} || defined $options->{builder} || exists + $options->{__hack_is_inherit} ) || $class->throw_error( "You cannot have a lazy attribute ($name) without specifying a default value for it", data => $options ); diff --git a/t/attributes/ealleniii_attr_inherit_test.t b/t/attributes/ealleniii_attr_inherit_test.t new file mode 100644 index 0000000..0e23c71 --- /dev/null +++ b/t/attributes/ealleniii_attr_inherit_test.t @@ -0,0 +1,63 @@ +package MyApp::Meta::Attribute; +use Moose::Role; + +around _process_lazy_build_option => sub { + my ( $orig, $class, $name, $options ) = @_; + $options->{default} = sub { return 'yep' }; + return $orig->($class , $name, $options); +}; + + + + +package MyApp; +use Moose; + +has 'fun' => ( + is => 'rw', + isa => 'Str' +); + +__PACKAGE__->meta->make_immutable; +no Moose; + +package MyApp::Child; +use Moose; + +extends qw(MyApp); + +has '+fun' => ( traits => ['MyApp::Meta::Attribute'] ); + +no Moose; +package MyApp::Brother; +use Moose; + +has 'fun' => ( + is => 'rw', + isa => 'Str', + traits => ['MyApp::Meta::Attribute'] +); + +__PACKAGE__->meta->make_immutable; +no Moose; + +package main; + +use Test::More tests => 6; # last test to print + +my $testa = MyApp::Child->new(); +my $testb = MyApp::Brother->new(); + +for my $test ($testa,$testb) { + my $attr = $test->meta->find_attribute_by_name('fun'); + + ok ( $attr->has_applied_traits, 'Traits get applied to ' . ref($test)); + + my @good = grep {$_ eq 'MyApp::Meta::Attribute'} @{$attr->applied_traits}; + + ok (scalar @good, 'My traits get applied to '. ref($test)); + is( $test->fun, 'yep', 'Default was set by role for ' .ref($test) ); +} + + +


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.