sub _strip_traits {
my $idx = first_index { $_ eq '-traits' } @_;
- return unless $idx && $#_ >= $idx + 1;
+ return (undef, @_) unless $idx >= 0 && $#_ >= $idx + 1;
my $traits = $_[ $idx + 1 ];
splice @_, $idx, 2;
- return ( $traits, @_ )
+ return ($traits, @_);
}
# 1 extra level because it's called by import so there's a layer of indirection
return
unless $traits && @$traits;
- if ( @$traits == 1 ) {
- $traits->[0]->meta()->apply_to_metaclass_instance( $class->meta() );
- } else {
- Moose::Meta::Role->combine(@$traits)
- ->apply_to_metaclass_instance( $class->meta() );
- }
+ my $meta = $class->meta();
+
+ Moose::Util::apply_all_roles_with_method($meta, 'apply_to_metaclass_instance', $traits);
}
sub import {
+ # This is a bit gross, but it's necessary for backwards
+ # compatibility, so that _get_caller() sees the arguments in
+ # the right order.
my $traits;
- ( $traits, @_ ) = _strip_traits(@_);
+ ($traits, @_) = _strip_traits(@_);
$CALLER = _get_caller(@_);
sub apply_all_roles {
my $applicant = shift;
-
- confess "Must specify at least one role to apply to $applicant" unless @_;
-
- my $roles = Data::OptList::mkopt([ @_ ]);
-
- #use Data::Dumper;
- #warn Dumper $roles;
-
+
+ apply_all_roles_with_method( $applicant, 'apply', [@_] );
+}
+
+sub apply_all_roles_with_method {
+ my ($applicant, $apply_method, $role_list) = @_;
+
+ confess "Must specify at least one role to apply to $applicant" unless @$role_list;
+
+ my $roles = Data::OptList::mkopt($role_list);
+
my $meta = (blessed $applicant ? $applicant : find_meta($applicant));
-
+
foreach my $role_spec (@$roles) {
Class::MOP::load_class($role_spec->[0]);
}
-
+
($_->[0]->can('meta') && $_->[0]->meta->isa('Moose::Meta::Role'))
|| confess "You can only consume roles, " . $_->[0] . " is not a Moose role"
foreach @$roles;
if (scalar @$roles == 1) {
my ($role, $params) = @{$roles->[0]};
- $role->meta->apply($meta, (defined $params ? %$params : ()));
+ $role->meta->$apply_method($meta, (defined $params ? %$params : ()));
}
else {
Moose::Meta::Role->combine(
@$roles
- )->apply($meta);
- }
+ )->$apply_method($meta);
+ }
}
# instance deconstruction ...
use strict;
use warnings;
-use Test::More tests => 6;
+use Test::More 'no_plan';
{
package My::SimpleTrait;
can_ok( Bar->meta(), 'attr' );
is( Bar->meta()->attr(), 'something',
'Bar->meta()->attr() returns expected value' );
+
+{
+ package My::SimpleTrait3;
+
+ use Moose::Role;
+
+ # This needs to happen at begin time so it happens before we apply
+ # traits to Bar
+ BEGIN {
+ has 'attr2' =>
+ ( is => 'ro',
+ default => 'something',
+ );
+ }
+
+ sub simple2 { return 55 }
+}
+
+
+{
+ package Baz;
+
+ use Moose -traits => [ 'My::SimpleTrait2', 'My::SimpleTrait3' ];
+}
+
+can_ok( Baz->meta(), 'simple' );
+is( Baz->meta()->simple(), 5,
+ 'Baz->meta()->simple() returns expected value' );
+can_ok( Baz->meta(), 'attr' );
+is( Baz->meta()->attr(), 'something',
+ 'Baz->meta()->attr() returns expected value' );
+can_ok( Baz->meta(), 'simple2' );
+is( Baz->meta()->simple2(), 55,
+ 'Baz->meta()->simple2() returns expected value' );
+can_ok( Baz->meta(), 'attr2' );
+is( Baz->meta()->attr2(), 'something',
+ 'Baz->meta()->attr2() returns expected value' );