Also see Moose::Manual::Delta for more details of, and workarounds
for, noteworthy changes.
+ * Moose::Meta::Role
+ - Role attributes are now objects of the Moose::Meta::Role::Attribute
+ class. (Dave Rolsky).
+
+ * Moose::Util::MetaRole
+ - Major changes to how metaroles are applied. We now distinguish between
+ metaroles for classes vs those for roles. See the Moose::Util::MetaRole
+ docs for details. (Dave Rolsky)
+
* Moose::Exporter
- The unimport subs it generates now clean up re-exported functions like
blessed and confess, unless the caller imported them from somewhere
sub check_conflicts {
my %conflicts = (
'Fey::ORM' => '0.23',
- 'MooseX::AttributeHelpers' => '0.21',
+ 'MooseX::Aliases' => '0.07',
+ 'MooseX::AttributeHelpers' => '0.22',
'MooseX::ClassAttribute' => '0.09',
- 'MooseX::MethodAttributes' => '0.15',
+ 'MooseX::MethodAttributes' => '0.18',
'MooseX::NonMoose' => '0.05',
'MooseX::Params::Validate' => '0.05',
'MooseX::Singleton' => '0.19',
Moose::Meta::Method::Augmented
Moose::Meta::Role
+ Moose::Meta::Role::Attribute
Moose::Meta::Role::Method
Moose::Meta::Role::Method::Required
Moose::Meta::Role::Method::Conflicting
Moose::Meta::Role::Application::ToInstance
);
+Moose::Meta::Mixin::AttributeCore->meta->make_immutable(
+ inline_constructor => 0,
+ constructor_name => undef,
+);
+
1;
__END__
return unless @resolved_traits;
- Moose::Util::MetaRole::apply_metaclass_roles(
- for_class => $class,
- metaclass_roles => \@resolved_traits,
- );
+ my %args = ( for => $class );
+
+ if ( $meta->isa('Moose::Meta::Role') ) {
+ $args{role_metaroles} = { role => \@resolved_traits };
+ }
+ else {
+ $args{class_metaroles} = { class => \@resolved_traits };
+ }
+
+ Moose::Util::MetaRole::apply_metaroles(%args);
}
sub _get_caller {
my $class = shift;
my $args = shift;
- my %metaclass_roles;
+ my %old_style_roles;
for my $role (
map {"${_}_roles"}
- qw(metaclass
+ qw(
+ metaclass
attribute_metaclass
method_metaclass
wrapped_method_metaclass
constructor_class
destructor_class
error_class
- application_to_class_class
- application_to_role_class
- application_to_instance_class)
+ )
) {
- $metaclass_roles{$role} = $args->{$role} if exists $args->{$role};
+ $old_style_roles{$role} = $args->{$role}
+ if exists $args->{$role};
}
my %base_class_roles;
%base_class_roles = ( roles => $args->{base_class_roles} )
if exists $args->{base_class_roles};
- return unless %metaclass_roles || %base_class_roles;
+ my %new_style_roles = map { $_ => $args->{$_} }
+ grep { exists $args->{$_} } qw( class_metaroles role_metaroles );
+
+ return unless %new_style_roles || %old_style_roles || %base_class_roles;
return sub {
shift;
return unless Class::MOP::class_of( $options{for_class} );
- Moose::Util::MetaRole::apply_metaclass_roles(
- for_class => $options{for_class},
- %metaclass_roles,
+ Moose::Util::MetaRole::apply_metaroles(
+ for => $options{for_class},
+ %new_style_roles,
+ %old_style_roles,
);
Moose::Util::MetaRole::apply_base_class_roles(
=back
-Any of the C<*_roles> options for
-C<Moose::Util::MetaRole::apply_metaclass_roles> and
-C<Moose::Util::MetaRole::base_class_roles> are also acceptable.
+You can also provide parameters for C<Moose::Util::MetaRole::apply_metaroles>
+and C<Moose::Util::MetaRole::base_class_roles>. Specifically, valid parameters
+are "class_metaroles", "role_metaroles", and "base_object_roles".
=item B<< Moose::Exporter->build_import_methods(...) >>
=over 4
+=item Moose::Util::MetaRole API has changed
+
+The C<apply_metaclass_roles> function is now called C<apply_metaroles>. The
+way arguments are supplied has been changed to force you to distinguish
+between metaroles applied to L<Moose::Meta::Class> (and helpers) versus
+L<Moose::Meta::Role>.
+
+The old API still works, but will warn in a future release, and eventually be
+removed.
+
+=item Moose::Meta::Role has real attributes
+
+The attributes returned by L<Moose::Meta::Role> are now instances of the
+L<Moose::Meta::Role::Attribute> class, instead of bare hash references.
+
+<<<<<<< HEAD:lib/Moose/Manual/Delta.pod
=item "no Moose" now removes C<blessed> and C<confess>
Moose is now smart enough to know exactly what it exported, even when it
use Moose::Util ();
use Moose::Util::TypeConstraints ();
-use base 'Class::MOP::Attribute';
-
-# options which are not directly used
-# but we store them for metadata purposes
-__PACKAGE__->meta->add_attribute('isa' => (reader => '_isa_metadata'));
-__PACKAGE__->meta->add_attribute('does' => (reader => '_does_metadata'));
-__PACKAGE__->meta->add_attribute('is' => (reader => '_is_metadata'));
-
-# these are actual options for the attrs
-__PACKAGE__->meta->add_attribute('required' => (reader => 'is_required' ));
-__PACKAGE__->meta->add_attribute('lazy' => (reader => 'is_lazy' ));
-__PACKAGE__->meta->add_attribute('lazy_build' => (reader => 'is_lazy_build' ));
-__PACKAGE__->meta->add_attribute('coerce' => (reader => 'should_coerce' ));
-__PACKAGE__->meta->add_attribute('weak_ref' => (reader => 'is_weak_ref' ));
-__PACKAGE__->meta->add_attribute('auto_deref' => (reader => 'should_auto_deref'));
-__PACKAGE__->meta->add_attribute('type_constraint' => (
- reader => 'type_constraint',
- predicate => 'has_type_constraint',
-));
-__PACKAGE__->meta->add_attribute('trigger' => (
- reader => 'trigger',
- predicate => 'has_trigger',
-));
-__PACKAGE__->meta->add_attribute('handles' => (
- reader => 'handles',
- writer => '_set_handles',
- predicate => 'has_handles',
-));
-__PACKAGE__->meta->add_attribute('documentation' => (
- reader => 'documentation',
- predicate => 'has_documentation',
-));
+use base 'Class::MOP::Attribute', 'Moose::Meta::Mixin::AttributeCore';
+
__PACKAGE__->meta->add_attribute('traits' => (
reader => 'applied_traits',
predicate => 'has_applied_traits',
},
);
-has '+default' => ( required => 1 );
-has '+type_constraint' => ( required => 1 );
-
# methods called prior to instantiation
before '_process_options' => sub {
);
}
+sub reinitialize {
+ my $self = shift;
+ my $pkg = shift;
+
+ my $meta = blessed $pkg ? $pkg : Class::MOP::class_of($pkg);
+
+ my %existing_classes;
+ if ($meta) {
+ %existing_classes = map { $_ => $meta->$_() } qw(
+ attribute_metaclass
+ method_metaclass
+ wrapped_method_metaclass
+ instance_metaclass
+ constructor_class
+ destructor_class
+ error_class
+ );
+ }
+
+ return $self->SUPER::reinitialize(
+ $pkg,
+ %existing_classes,
+ @_,
+ );
+}
+
sub _immutable_options {
my ( $self, @args ) = @_;
--- /dev/null
+package Moose::Meta::Mixin::AttributeCore;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.93';
+our $AUTHORITY = 'cpan:STEVAN';
+
+use base 'Class::MOP::Mixin::AttributeCore';
+
+__PACKAGE__->meta->add_attribute( 'isa' => ( reader => '_isa_metadata' ) );
+__PACKAGE__->meta->add_attribute( 'does' => ( reader => '_does_metadata' ) );
+__PACKAGE__->meta->add_attribute( 'is' => ( reader => '_is_metadata' ) );
+
+__PACKAGE__->meta->add_attribute( 'required' => ( reader => 'is_required' ) );
+__PACKAGE__->meta->add_attribute( 'lazy' => ( reader => 'is_lazy' ) );
+__PACKAGE__->meta->add_attribute(
+ 'lazy_build' => ( reader => 'is_lazy_build' ) );
+__PACKAGE__->meta->add_attribute( 'coerce' => ( reader => 'should_coerce' ) );
+__PACKAGE__->meta->add_attribute( 'weak_ref' => ( reader => 'is_weak_ref' ) );
+__PACKAGE__->meta->add_attribute(
+ 'auto_deref' => ( reader => 'should_auto_deref' ) );
+__PACKAGE__->meta->add_attribute(
+ 'type_constraint' => (
+ reader => 'type_constraint',
+ predicate => 'has_type_constraint',
+ )
+);
+__PACKAGE__->meta->add_attribute(
+ 'trigger' => (
+ reader => 'trigger',
+ predicate => 'has_trigger',
+ )
+);
+__PACKAGE__->meta->add_attribute(
+ 'handles' => (
+ reader => 'handles',
+ writer => '_set_handles',
+ predicate => 'has_handles',
+ )
+);
+__PACKAGE__->meta->add_attribute(
+ 'documentation' => (
+ reader => 'documentation',
+ predicate => 'has_documentation',
+ )
+);
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Moose::Meta::Mixin::AttributeCore - Core attributes shared by attribute metaclasses
+
+=head1 DESCRIPTION
+
+This class implements the core attributes (aka properties) shared by all Moose
+attributes. See the L<Moose::Meta::Attribute> documentation for API details.
+
+=head1 AUTHORS
+
+Dave Rolsky E<lt>autarch@urth.orgE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2006-2009 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
our $AUTHORITY = 'cpan:STEVAN';
use Moose::Meta::Class;
+use Moose::Meta::Role::Attribute;
use Moose::Meta::Role::Method;
use Moose::Meta::Role::Method::Required;
use Moose::Meta::Role::Method::Conflicting;
+use Moose::Util qw( ensure_all_roles );
-use base 'Class::MOP::Module';
+use base 'Class::MOP::Module', 'Class::MOP::Mixin::HasAttributes';
## ------------------------------------------------------------------
## NOTE:
existence => 'requires_method',
}
},
- {
- name => '_attribute_map',
- attr_reader => '_attribute_map',
- methods => {
- get => 'get_attribute',
- get_keys => 'get_attribute_list',
- existence => 'has_attribute',
- remove => 'remove_attribute',
- }
- }
) {
my $attr_reader = $action->{attr_reader};
default => 'Moose::Meta::Role::Application::ToInstance',
);
-## some things don't always fit, so they go here ...
+# More or less copied from Moose::Meta::Class
+sub initialize {
+ my $class = shift;
+ my $pkg = shift;
+ return Class::MOP::get_metaclass_by_name($pkg)
+ || $class->SUPER::initialize(
+ $pkg,
+ 'attribute_metaclass' => 'Moose::Meta::Role::Attribute',
+ @_
+ );
+}
-sub add_attribute {
+sub reinitialize {
my $self = shift;
- my $name = shift;
- unless ( defined $name ) {
- require Moose;
- Moose->throw_error("You must provide a name for the attribute");
+ my $pkg = shift;
+
+ my $meta = blessed $pkg ? $pkg : Class::MOP::class_of($pkg);
+
+ my %existing_classes;
+ if ($meta) {
+ %existing_classes = map { $_ => $meta->$_() } qw(
+ attribute_metaclass
+ method_metaclass
+ wrapped_method_metaclass
+ required_method_metaclass
+ conflicting_method_metaclass
+ application_to_class_class
+ application_to_role_class
+ application_to_instance_class
+ );
}
- my $attr_desc;
- if (scalar @_ == 1 && ref($_[0]) eq 'HASH') {
- $attr_desc = $_[0];
- }
- else {
- $attr_desc = { @_ };
+
+ return $self->SUPER::reinitialize(
+ $pkg,
+ %existing_classes,
+ @_,
+ );
+}
+
+sub add_attribute {
+ my $self = shift;
+
+ if (blessed $_[0] && ! $_[0]->isa('Moose::Meta::Role::Attribute') ) {
+ my $class = ref $_[0];
+ Moose->throw_error( "Cannot add a $class as an attribute to a role" );
}
- $self->_attribute_map->{$name} = $attr_desc;
+
+ return $self->SUPER::add_attribute(@_);
+}
+
+sub _attach_attribute {
+ my ( $self, $attribute ) = @_;
+
+ $attribute->attach_to_role($self);
}
sub add_required_methods {
if (exists $options{attributes}) {
foreach my $attribute_name (keys %{$options{attributes}}) {
my $attr = $options{attributes}->{$attribute_name};
- $meta->add_attribute($attribute_name => $attr);
+ $meta->add_attribute(
+ $attribute_name => blessed $attr ? $attr : %{$attr} );
}
}
# }
# );
#
-# has 'attribute_map' => (
-# metaclass => 'Hash',
-# reader => '_attribute_map',
-# isa => 'HashRef[Str]',
-# provides => {
-# # 'set' => 'add_attribute' # has some special crap in it
-# 'get' => 'get_attribute',
-# 'keys' => 'get_attribute_list',
-# 'exists' => 'has_attribute',
-# # Not exactly delete, cause it sets multiple
-# 'delete' => 'remove_attribute',
-# }
-# );
-#
# has 'required_methods' => (
# metaclass => 'Hash',
# reader => 'get_required_methods_map',
sub apply_attributes {
my ($self, $c) = @_;
- my @all_attributes = map {
- my $role = $_;
- map {
- +{
- name => $_,
- attr => $role->get_attribute($_),
- }
- } $role->get_attribute_list
- } @{$c->get_roles};
+ my @all_attributes;
+
+ for my $role ( @{ $c->get_roles } ) {
+ push @all_attributes,
+ map { $role->get_attribute($_) } $role->get_attribute_list;
+ }
my %seen;
foreach my $attr (@all_attributes) {
- if (exists $seen{$attr->{name}}) {
- if ( $seen{$attr->{name}} != $attr->{attr} ) {
- require Moose;
- Moose->throw_error("We have encountered an attribute conflict with '" . $attr->{name} . "' "
- . "during composition. This is fatal error and cannot be disambiguated.")
- }
+ my $name = $attr->name;
+
+ if ( exists $seen{$name} ) {
+ next if $seen{$name}->is_same_as($attr);
+
+ my $role1 = $seen{$name}->associated_role->name;
+ my $role2 = $attr->associated_role->name;
+
+ require Moose;
+ Moose->throw_error(
+ "We have encountered an attribute conflict with '$name' "
+ . "during role composition. "
+ . " This attribute is defined in both $role1 and $role2."
+ . " This is fatal error and cannot be disambiguated." );
}
- $seen{$attr->{name}} = $attr->{attr};
+
+ $seen{$name} = $attr;
}
foreach my $attr (@all_attributes) {
- $c->add_attribute($attr->{name}, $attr->{attr});
+ $c->add_attribute( $attr->clone );
}
}
sub apply_attributes {
my ($self, $role, $class) = @_;
+ my $attr_metaclass = $class->attribute_metaclass;
+
foreach my $attribute_name ($role->get_attribute_list) {
# it if it has one already
if ($class->has_attribute($attribute_name) &&
}
else {
$class->add_attribute(
- $attribute_name,
- $role->get_attribute($attribute_name)
+ $role->get_attribute($attribute_name)->attribute_for_class($attr_metaclass)
);
}
}
}
else {
my $obj_meta = Class::MOP::class_of($object) || 'Moose::Meta::Class';
+
+ # This is a special case to handle the case where the object's
+ # metaclass is a Class::MOP::Class, but _not_ a Moose::Meta::Class
+ # (for example, when applying a role to a Moose::Meta::Attribute
+ # object).
+ $obj_meta = 'Moose::Meta::Class'
+ unless $obj_meta->isa('Moose::Meta::Class');
+
$class = $obj_meta->create_anon_class(
superclasses => [ blessed($object) ]
);
}
else {
$role2->add_attribute(
- $attribute_name,
- $role1->get_attribute($attribute_name)
+ $role1->get_attribute($attribute_name)->clone
);
}
}
--- /dev/null
+package Moose::Meta::Role::Attribute;
+
+use strict;
+use warnings;
+
+use Carp 'confess';
+use List::MoreUtils 'all';
+use Scalar::Util 'blessed', 'weaken';
+
+our $VERSION = '0.93';
+our $AUTHORITY = 'cpan:STEVAN';
+
+use base 'Moose::Meta::Mixin::AttributeCore';
+
+__PACKAGE__->meta->add_attribute(
+ 'metaclass' => (
+ reader => 'metaclass',
+ )
+);
+
+__PACKAGE__->meta->add_attribute(
+ 'associated_role' => (
+ reader => 'associated_role',
+ )
+);
+
+__PACKAGE__->meta->add_attribute(
+ 'is' => (
+ reader => 'is',
+ )
+);
+
+__PACKAGE__->meta->add_attribute(
+ 'original_options' => (
+ reader => 'original_options',
+ )
+);
+
+sub new {
+ my ( $class, $name, %options ) = @_;
+
+ (defined $name)
+ || confess "You must provide a name for the attribute";
+
+ return bless {
+ name => $name,
+ original_options => \%options,
+ %options,
+ }, $class;
+}
+
+sub attach_to_role {
+ my ( $self, $role ) = @_;
+
+ ( blessed($role) && $role->isa('Moose::Meta::Role') )
+ || confess
+ "You must pass a Moose::Meta::Role instance (or a subclass)";
+
+ weaken( $self->{'associated_role'} = $role );
+}
+
+sub attribute_for_class {
+ my $self = shift;
+ my $metaclass = shift;
+
+ return $metaclass->interpolate_class_and_new(
+ $self->name => %{ $self->original_options } );
+}
+
+sub clone {
+ my $self = shift;
+
+ return ( ref $self )->new( $self->name, %{ $self->original_options } );
+}
+
+sub is_same_as {
+ my $self = shift;
+ my $attr = shift;
+
+ my $self_options = $self->original_options;
+ my $other_options = $attr->original_options;
+
+ return 0
+ unless ( join q{|}, sort keys %{$self_options} ) eq ( join q{|}, sort keys %{$other_options} );
+
+ for my $key ( keys %{$self_options} ) {
+ return 0 if defined $self_options->{$key} && ! defined $other_options->{$key};
+ return 0 if ! defined $self_options->{$key} && defined $other_options->{$key};
+
+ next if all { ! defined } $self_options->{$key}, $other_options->{$key};
+
+ return 0 unless $self_options->{$key} eq $other_options->{$key};
+ }
+
+ return 1;
+}
+
+1;
+
+=pod
+
+=head1 NAME
+
+Moose::Meta::Role::Attribute - A Moose Attribute metaclass for Roles
+
+=head1 DESCRIPTION
+
+This class implements the API for attributes in roles. Attributes in roles are
+more like attribute prototypes than full blown attributes. While they are
+introspectable, they have very little behavior.
+
+=head1 METHODS
+
+This class provides the following methods:
+
+=over 4
+
+=item B<< Moose::Meta::Role::Attribute->new(...) >>
+
+This method accepts all the options that would be passed to the constructor
+for L<Moose::Meta::Attribute>.
+
+=item B<< $attr->metaclass >>
+
+=item B<< $attr->is >>
+
+Returns the option as passed to the constructor.
+
+=item B<< $attr->associated_role >>
+
+Returns the L<Moose::Meta::Role> to which this attribute belongs, if any.
+
+=item B<< $attr->original_options >>
+
+Returns a hash reference of options passed to the constructor. This is used
+when creating a L<Moose::Meta::Attribute> object from this object.
+
+=item B<< $attr->attach_to_role($role) >>
+
+Attaches the attribute to the given L<Moose::Meta::Role>.
+
+=item B<< $attr->attribute_for_class($metaclass) >>
+
+Given an attribute metaclass name, this method calls C<<
+$metaclass->interpolate_class_and_new >> to construct an attribute object
+which can be added to a L<Moose::Meta::Class>.
+
+=item B<< $attr->clone >>
+
+Creates a new object identical to the object on which the method is called.
+
+=item B<< $attr->is_same_as($other_attr) >>
+
+Compares two role attributes and returns true if they are identical.
+
+=back
+
+In addition, this class implements all informational predicates implements by
+L<Moose::Meta::Attribute> (and L<Class::MOP::Attribute>).
+
+=head1 BUGS
+
+All complex software has bugs lurking in it, and this module is no
+exception. If you find a bug please either email me, or add the bug
+to cpan-RT.
+
+=head1 AUTHOR
+
+Dave Rolsky E<lt>autarch@urth.orgE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2006-2009 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
}
sub reinitialize {
- my ($class, $old_meta, @args) = @_;
- Moose->throw_error('Moose::Meta::Role::Composite instances can only be reinitialized from an existing metaclass instance')
- if !blessed $old_meta || !$old_meta->isa('Moose::Meta::Role::Composite');
- return $old_meta->meta->clone_object($old_meta, @args);
+ my ( $class, $old_meta, @args ) = @_;
+
+ Moose->throw_error(
+ 'Moose::Meta::Role::Composite instances can only be reinitialized from an existing metaclass instance'
+ )
+ if !blessed $old_meta
+ || !$old_meta->isa('Moose::Meta::Role::Composite');
+
+ my %existing_classes = map { $_ => $old_meta->$_() } qw(
+ application_role_summation_class
+ );
+
+ return $old_meta->meta->clone_object( $old_meta, %existing_classes, @args );
}
1;
our $AUTHORITY = 'cpan:STEVAN';
use List::MoreUtils qw( all );
-
-my @Classes = qw( constructor_class destructor_class error_class );
+use List::Util qw( first );
sub apply_metaclass_roles {
- my %options = @_;
-
- my $for = blessed $options{for_class}
- ? $options{for_class}
- : Class::MOP::class_of($options{for_class});
-
- my %old_classes = map { $_ => $for->$_ }
- grep { $for->can($_) }
- @Classes;
-
- my $meta = _make_new_metaclass( $for, \%options );
-
- for my $c ( grep { $meta->can($_) } @Classes ) {
- if ( $options{ $c . '_roles' } ) {
- my $class = _make_new_class(
- $meta->$c(),
- $options{ $c . '_roles' }
- );
-
- $meta->$c($class);
- }
- else {
- $meta->$c( $old_classes{$c} );
- }
+ goto &apply_metaroles;
+}
+
+sub apply_metaroles {
+ my %args = @_;
+
+ _fixup_old_style_args(\%args);
+ Carp::cluck('applying') if $::D;
+ my $for
+ = blessed $args{for}
+ ? $args{for}
+ : Class::MOP::class_of( $args{for} );
+
+ if ( $for->isa('Moose::Meta::Role') ) {
+ return _make_new_metaclass( $for, $args{role_metaroles}, 'role' );
+ }
+ else {
+ return _make_new_metaclass( $for, $args{class_metaroles}, 'class' );
}
+}
+
+sub _fixup_old_style_args {
+ my $args = shift;
+
+ return if $args->{class_metaroles} || $args->{roles_metaroles};
+
+ $args->{for} = delete $args->{for_class}
+ if exists $args->{for_class};
+
+ my @old_keys = qw(
+ attribute_metaclass_roles
+ method_metaclass_roles
+ wrapped_method_metaclass_roles
+ instance_metaclass_roles
+ constructor_class_roles
+ destructor_class_roles
+ error_class_roles
+
+ application_to_class_class_roles
+ application_to_role_class_roles
+ application_to_instance_class_roles
+ application_role_summation_class_roles
+ );
- return $meta;
+ my $for
+ = blessed $args->{for}
+ ? $args->{for}
+ : Class::MOP::class_of( $args->{for} );
+
+ my $top_key;
+ if ( $for->isa('Moose::Meta::Class') ) {
+ $top_key = 'class_metaroles';
+
+ $args->{class_metaroles}{class} = delete $args->{metaclass_roles}
+ if exists $args->{metaclass_roles};
+ }
+ else {
+ $top_key = 'role_metaroles';
+
+ $args->{role_metaroles}{role} = delete $args->{metaclass_roles}
+ if exists $args->{metaclass_roles};
+ }
+
+ for my $old_key (@old_keys) {
+ my ($new_key) = $old_key =~ /^(.+)_(?:class|metaclass)_roles$/;
+
+ $args->{$top_key}{$new_key} = delete $args->{$old_key}
+ if exists $args->{$old_key};
+ }
+
+ return;
}
sub _make_new_metaclass {
my $for = shift;
- my $options = shift;
-
- return $for
- unless grep { exists $options->{ $_ . '_roles' } }
- qw(
- metaclass
- attribute_metaclass
- method_metaclass
- wrapped_method_metaclass
- instance_metaclass
- application_to_class_class
- application_to_role_class
- application_to_instance_class
- application_role_summation_class
- );
+ my $roles = shift;
+ my $primary = shift;
+
+ return $for unless keys %{$roles};
my $new_metaclass
- = _make_new_class( ref $for, $options->{metaclass_roles} );
-
- # This could get called for a Moose::Meta::Role as well as a Moose::Meta::Class
- my %classes = map {
- $_ => _make_new_class( $for->$_(), $options->{ $_ . '_roles' } )
- }
- grep { $for->can($_) }
- qw(
- attribute_metaclass
- method_metaclass
- wrapped_method_metaclass
- instance_metaclass
- application_to_class_class
- application_to_role_class
- application_to_instance_class
- application_role_summation_class
- );
+ = exists $roles->{$primary}
+ ? _make_new_class( ref $for, $roles->{$primary} )
+ : blessed $for;
- return $new_metaclass->reinitialize( $for, %classes );
+ my %classes;
+
+ for my $key ( grep { $_ ne $primary } keys %{$roles} ) {
+ my $attr = first {$_}
+ map { $for->meta->find_attribute_by_name($_) } (
+ $key . '_metaclass',
+ $key . '_class'
+ );
+
+ my $reader = $attr->get_read_method;
+
+ $classes{ $attr->init_arg }
+ = _make_new_class( $for->$reader(), $roles->{$key} );
+ }
+
+ my $new_meta = $new_metaclass->reinitialize( $for, %classes );
+
+ return $new_meta;
}
sub apply_base_class_roles {
- my %options = @_;
+ my %args = @_;
- my $for = $options{for_class};
+ my $for = $args{for} || $args{for_class};
my $meta = Class::MOP::class_of($for);
my $new_base = _make_new_class(
$for,
- $options{roles},
+ $args{roles},
[ $meta->superclasses() ],
);
sub init_meta {
shift;
- my %options = @_;
+ my %args = @_;
- Moose->init_meta(%options);
+ Moose->init_meta(%args);
- Moose::Util::MetaRole::apply_metaclass_roles(
- for_class => $options{for_class},
- metaclass_roles => ['MyApp::Role::Meta::Class'],
- constructor_class_roles => ['MyApp::Role::Meta::Method::Constructor'],
+ Moose::Util::MetaRole::apply_metaroles(
+ for => $args{for_class},
+ class_metaroles => {
+ class => => ['MyApp::Role::Meta::Class'],
+ constructor => ['MyApp::Role::Meta::Method::Constructor'],
+ },
);
Moose::Util::MetaRole::apply_base_class_roles(
- for_class => $options{for_class},
- roles => ['MyApp::Role::Object'],
+ for => $args{for_class},
+ roles => ['MyApp::Role::Object'],
);
- return $options{for_class}->meta();
+ return $args{for_class}->meta();
}
=head1 DESCRIPTION
This module provides two functions.
-=head2 apply_metaclass_roles( ... )
+=head2 apply_metaroles( ... )
This function will apply roles to one or more metaclasses for the
specified class. It accepts the following parameters:
=over 4
-=item * for_class => $name
+=item * for => $name
+
+This specifies the class or for which to alter the meta classes. This can be a
+package name, or an appropriate meta-object (a L<Moose::Meta::Class> or
+L<Moose::Meta::Role>).
-This specifies the class for which to alter the meta classes.
+=item * class_metaroles => \%roles
-=item * metaclass_roles => \@roles
+This is a hash reference specifying which metaroles will be applied to the
+class metaclass and its contained metaclasses and helper classes.
-=item * attribute_metaclass_roles => \@roles
+Each key should in turn point to an array reference of role names.
-=item * method_metaclass_roles => \@roles
+It accepts the following keys:
-=item * wrapped_method_metaclass_roles => \@roles
+=over 8
-=item * instance_metaclass_roles => \@roles
+=item class
-=item * constructor_class_roles => \@roles
+=item attribute
-=item * destructor_class_roles => \@roles
+=item method
-=item * application_to_class_class_roles => \@roles
+=item wrapped_method
+
+=item instance
+
+=item constructor
+
+=item destructor
+
+=item error
+
+=back
-=item * application_to_role_class_roles => \@roles
+=item * role_metaroles => \%roles
-=item * application_to_instance_class_roles => \@roles
+This is a hash reference specifying which metaroles will be applied to the
+role metaclass and its contained metaclasses and helper classes.
-These parameter all specify one or more roles to be applied to the
-specified metaclass. You can pass any or all of these parameters at
-once.
+It accepts the following keys:
+
+=over 8
+
+=item role
+
+=item attribute
+
+=item method
+
+=item required_method
+
+=item conflicting_method
+
+=item application_to_class
+
+=item application_to_role
+
+=item application_to_instance
+
+=item application_role_summation
+
+=back
=back
-=head2 apply_base_class_roles( for_class => $class, roles => \@roles )
+=head2 apply_base_class_roles( for => $class, roles => \@roles )
This function will apply the specified roles to the object's base class.
does => role_type('Bar::Role')
);
+ package Foo::Class;
+ use Moose;
+
+ with 'Foo::Role';
+
package Bar::Role;
use Moose::Role;
# since the isa() check will imply the does() check
has 'foo' => (is => 'rw', isa => 'Foo::Class', does => 'Foo::Role');
- package Foo::Class;
- use Moose;
-
- with 'Foo::Role';
-
package Bar::Class;
use Moose;
with 'Bar::Role';
-
}
my $foo = Foo::Class->new;
use Test::More;
use Test::Exception;
- Moose::Util::MetaRole::apply_metaclass_roles(
- for_class => __PACKAGE__,
- instance_metaclass_roles => ['MooseX::SomeAwesomeDBFields']
+ Moose::Util::MetaRole::apply_metaroles(
+ for => __PACKAGE__,
+ class_metaroles => { instance => ['MooseX::SomeAwesomeDBFields'] },
);
lives_ok {
use Test::Exception;
use Moose::Meta::Role;
+use Moose::Util::TypeConstraints ();
{
package FooRole;
ok($foo_role->has_attribute('bar'), '... FooRole does have the bar attribute');
-is_deeply(
- $foo_role->get_attribute('bar'),
- { is => 'rw', isa => 'Foo' },
- '... got the correct description of the bar attribute');
+my $bar = $foo_role->get_attribute('bar');
+is_deeply( $bar->original_options, { is => 'rw', isa => 'Foo' },
+ 'original options for bar attribute' );
+my $bar_for_class = $bar->attribute_for_class('Moose::Meta::Attribute');
+is(
+ $bar_for_class->type_constraint,
+ Moose::Util::TypeConstraints::class_type('Foo'),
+ 'bar has a Foo class type'
+);
lives_ok {
$foo_role->add_attribute('baz' => (is => 'ro'));
ok($foo_role->has_attribute('baz'), '... FooRole does have the baz attribute');
-is_deeply(
- $foo_role->get_attribute('baz'),
- { is => 'ro' },
- '... got the correct description of the baz attribute');
+my $baz = $foo_role->get_attribute('baz');
+is_deeply( $baz->original_options, { is => 'ro' },
+ 'original options for baz attribute' );
lives_ok {
$foo_role->remove_attribute('bar');
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+
+use Moose ();
+use Moose::Meta::Role;
+use Moose::Util;
+
+my $role1 = Moose::Meta::Role->initialize('Foo');
+$role1->add_attribute( foo => ( is => 'ro' ) );
+
+ok( $role1->has_attribute('foo'), 'Foo role has a foo attribute' );
+
+my $foo_attr = $role1->get_attribute('foo');
+is(
+ $foo_attr->associated_role->name, 'Foo',
+ 'associated_role for foo attr is Foo role'
+);
+
+isa_ok(
+ $foo_attr->attribute_for_class('Moose::Meta::Attribute'),
+ 'Moose::Meta::Attribute',
+ 'attribute returned by ->attribute_for_class'
+);
+
+my $role2 = Moose::Meta::Role->initialize('Bar');
+$role1->apply($role2);
+
+ok( $role2->has_attribute('foo'), 'Bar role has a foo attribute' );
+
+is(
+ $foo_attr->associated_role->name, 'Foo',
+ 'associated_role for foo attr is still Foo role'
+);
+
+isa_ok(
+ $foo_attr->attribute_for_class('Moose::Meta::Attribute'),
+ 'Moose::Meta::Attribute',
+ 'attribute returned by ->attribute_for_class'
+);
+
+my $role3 = Moose::Meta::Role->initialize('Baz');
+my $combined = Moose::Meta::Role->combine( [ $role1->name ], [ $role3->name ] );
+
+ok( $combined->has_attribute('foo'), 'combined role has a foo attribute' );
+
+is(
+ $foo_attr->associated_role->name, 'Foo',
+ 'associated_role for foo attr is still Foo role'
+);
+
+done_testing;
}
{
- Moose::Util::MetaRole::apply_metaclass_roles(
- for_class => My::Class->meta,
- metaclass_roles => ['Role::Foo'],
+ Moose::Util::MetaRole::apply_metaroles(
+ for => My::Class->meta,
+ class_metaroles => { class => ['Role::Foo'] },
);
ok( My::Class->meta()->meta()->does_role('Role::Foo'),
}
{
- Moose::Util::MetaRole::apply_metaclass_roles(
- for_class => 'My::Class',
- attribute_metaclass_roles => ['Role::Foo'],
+ Moose::Util::MetaRole::apply_metaroles(
+ for => 'My::Class',
+ class_metaroles => { attribute => ['Role::Foo'] },
);
ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
}
{
- Moose::Util::MetaRole::apply_metaclass_roles(
- for_class => 'My::Class',
- method_metaclass_roles => ['Role::Foo'],
+ Moose::Util::MetaRole::apply_metaroles(
+ for => 'My::Class',
+ class_metaroles => { method => ['Role::Foo'] },
);
ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
}
{
- Moose::Util::MetaRole::apply_metaclass_roles(
- for_class => 'My::Class',
- wrapped_method_metaclass_roles => ['Role::Foo'],
+ Moose::Util::MetaRole::apply_metaroles(
+ for => 'My::Class',
+ class_metaroles => { wrapped_method => ['Role::Foo'] },
);
ok( My::Class->meta()->wrapped_method_metaclass()->meta()->does_role('Role::Foo'),
}
{
- Moose::Util::MetaRole::apply_metaclass_roles(
- for_class => 'My::Class',
- instance_metaclass_roles => ['Role::Foo'],
+ Moose::Util::MetaRole::apply_metaroles(
+ for => 'My::Class',
+ class_metaroles => { instance => ['Role::Foo'] },
);
ok( My::Class->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
}
{
- Moose::Util::MetaRole::apply_metaclass_roles(
- for_class => 'My::Class',
- constructor_class_roles => ['Role::Foo'],
+ Moose::Util::MetaRole::apply_metaroles(
+ for => 'My::Class',
+ class_metaroles => { constructor => ['Role::Foo'] },
);
ok( My::Class->meta()->constructor_class()->meta()->does_role('Role::Foo'),
}
{
- Moose::Util::MetaRole::apply_metaclass_roles(
- for_class => 'My::Class',
- destructor_class_roles => ['Role::Foo'],
+ Moose::Util::MetaRole::apply_metaroles(
+ for => 'My::Class',
+ class_metaroles => { destructor => ['Role::Foo'] },
);
ok( My::Class->meta()->destructor_class()->meta()->does_role('Role::Foo'),
}
{
- Moose::Util::MetaRole::apply_metaclass_roles(
- for_class => 'My::Role',
- application_to_class_class_roles => ['Role::Foo'],
+ Moose::Util::MetaRole::apply_metaroles(
+ for => 'My::Role',
+ role_metaroles => { application_to_class => ['Role::Foo'] },
);
ok( My::Role->meta->application_to_class_class->meta->does_role('Role::Foo'),
}
{
- Moose::Util::MetaRole::apply_metaclass_roles(
- for_class => 'My::Role',
- application_to_role_class_roles => ['Role::Foo'],
+ Moose::Util::MetaRole::apply_metaroles(
+ for => 'My::Role',
+ role_metaroles => { application_to_role => ['Role::Foo'] },
);
ok( My::Role->meta->application_to_role_class->meta->does_role('Role::Foo'),
}
{
- Moose::Util::MetaRole::apply_metaclass_roles(
- for_class => 'My::Role',
- application_to_instance_class_roles => ['Role::Foo'],
+ Moose::Util::MetaRole::apply_metaroles(
+ for => 'My::Role',
+ role_metaroles => { application_to_instance => ['Role::Foo'] },
);
ok( My::Role->meta->application_to_instance_class->meta->does_role('Role::Foo'),
{
Moose::Util::MetaRole::apply_base_class_roles(
- for_class => 'My::Class',
- roles => ['Role::Foo'],
+ for => 'My::Class',
+ roles => ['Role::Foo'],
);
ok( My::Class->meta()->does_role('Role::Foo'),
}
{
- Moose::Util::MetaRole::apply_metaclass_roles(
- for_class => 'My::Class2',
- metaclass_roles => ['Role::Foo'],
- attribute_metaclass_roles => ['Role::Foo'],
- method_metaclass_roles => ['Role::Foo'],
- instance_metaclass_roles => ['Role::Foo'],
- constructor_class_roles => ['Role::Foo'],
- destructor_class_roles => ['Role::Foo'],
+ Moose::Util::MetaRole::apply_metaroles(
+ for => 'My::Class2',
+ class_metaroles => {
+ class => ['Role::Foo'],
+ attribute => ['Role::Foo'],
+ method => ['Role::Foo'],
+ instance => ['Role::Foo'],
+ constructor => ['Role::Foo'],
+ destructor => ['Role::Foo'],
+ },
);
ok( My::Class2->meta()->meta()->does_role('Role::Foo'),
{
- Moose::Util::MetaRole::apply_metaclass_roles(
- for_class => 'My::Class3',
- metaclass_roles => ['Role::Foo'],
+ Moose::Util::MetaRole::apply_metaroles(
+ for => 'My::Class3',
+ class_metaroles => { class => ['Role::Foo'] },
);
ok( My::Class3->meta()->meta()->does_role('Role::Foo'),
is( My::Class3->meta()->foo(), 10,
'... and call foo() on that meta object' );
ok( ( grep { $_ eq 'My::Meta::Class' } My::Class3->meta()->meta()->superclasses() ),
- 'apply_metaclass_roles() does not interfere with metaclass set via Moose->init_meta()' );
+ 'apply_metaroles() does not interfere with metaclass set via Moose->init_meta()' );
}
{
}
{
- Moose::Util::MetaRole::apply_metaclass_roles(
- for_class => 'My::Class4',
- metaclass_roles => ['Role::Foo'],
+ Moose::Util::MetaRole::apply_metaroles(
+ for => 'My::Class4',
+ class_metaroles => { class => ['Role::Foo'] },
);
ok( My::Class4->meta()->meta()->does_role('Role::Foo'),
'apply Role::Foo to My::Class4->meta()' );
- Moose::Util::MetaRole::apply_metaclass_roles(
- for_class => 'My::Class4',
- metaclass_roles => ['Role::Bar'],
+ Moose::Util::MetaRole::apply_metaroles(
+ for => 'My::Class4',
+ class_metaroles => { class => ['Role::Bar'] },
);
ok( My::Class4->meta()->meta()->does_role('Role::Bar'),
}
{
- Moose::Util::MetaRole::apply_metaclass_roles(
- for_class => 'My::Class5',
- metaclass_roles => ['Role::Bar'],
+ Moose::Util::MetaRole::apply_metaroles(
+ for => 'My::Class5',
+ class_metaroles => { class => ['Role::Bar'] },
);
ok( My::Class5->meta()->meta()->does_role('Role::Bar'),
package My::Class6;
use Moose;
- Moose::Util::MetaRole::apply_metaclass_roles(
- for_class => 'My::Class6',
- metaclass_roles => ['Role::Bar'],
+ Moose::Util::MetaRole::apply_metaroles(
+ for => 'My::Class6',
+ class_metaroles => { class => ['Role::Bar'] },
);
extends 'My::Class';
use Moose;
# In real usage this would go in a BEGIN block so it happened
- # before apply_metaclass_roles was called by an extension.
+ # before apply_metaroles was called by an extension.
extends 'My::Class';
- Moose::Util::MetaRole::apply_metaclass_roles(
- for_class => 'My::Class7',
- metaclass_roles => ['Role::Bar'],
+ Moose::Util::MetaRole::apply_metaroles(
+ for => 'My::Class7',
+ class_metaroles => { class => ['Role::Bar'] },
);
}
package My::Class8;
use Moose;
- Moose::Util::MetaRole::apply_metaclass_roles(
- for_class => 'My::Class8',
- metaclass_roles => ['Role::Bar'],
- attribute_metaclass_roles => ['Role::Bar'],
+ Moose::Util::MetaRole::apply_metaroles(
+ for => 'My::Class8',
+ class_metaroles => {
+ class => ['Role::Bar'],
+ attribute => ['Role::Bar'],
+ },
);
extends 'My::Class';
package My::Class9;
use Moose;
- Moose::Util::MetaRole::apply_metaclass_roles(
- for_class => 'My::Class9',
- attribute_metaclass_roles => ['Role::Bar'],
+ Moose::Util::MetaRole::apply_metaroles(
+ for => 'My::Class9',
+ class_metaroles => { attribute => ['Role::Bar'] },
);
extends 'My::Class';
use Moose;
extends 'Moose::Meta::Class';
- Moose::Util::MetaRole::apply_metaclass_roles(
- for_class => 'My::Meta::Class2',
- metaclass_roles => ['Role::Foo'],
+ Moose::Util::MetaRole::apply_metaroles(
+ for => 'My::Meta::Class2',
+ class_metaroles => { class => ['Role::Foo'] },
);
}
package My::Class10;
My::Meta2->import;
- Moose::Util::MetaRole::apply_metaclass_roles(
- for_class => 'My::Class10',
- metaclass_roles => ['Role::Bar'],
+ Moose::Util::MetaRole::apply_metaroles(
+ for => 'My::Class10',
+ class_metaroles => { class => ['Role::Bar'] },
);
}
__PACKAGE__->meta->constructor_class('My::Constructor');
- Moose::Util::MetaRole::apply_metaclass_roles(
- for_class => 'My::Class11',
- metaclass_roles => ['Role::Foo'],
+ Moose::Util::MetaRole::apply_metaroles(
+ for => 'My::Class11',
+ class_metaroles => { class => ['Role::Foo'] },
);
}
package ExportsMoose;
Moose::Exporter->setup_import_methods(
- also => 'Moose',
+ also => 'Moose',
);
sub init_meta {
shift;
my %p = @_;
Moose->init_meta(%p);
- return Moose::Util::MetaRole::apply_metaclass_roles(
+ return Moose::Util::MetaRole::apply_metaroles(
for_class => $p{for_class},
# Causes us to recurse through init_meta, as we have to
# load MyMetaclassRole from disk.
use Moose::Role;
}
+
{
package Foo::Role;
Moose::Exporter->setup_import_methods(
- also => 'Moose::Role',
+ also => 'Moose::Role',
);
sub init_meta {
shift;
my %p = @_;
+
Moose::Role->init_meta(%p);
- return Moose::Util::MetaRole::apply_metaclass_roles(
- for_class => $p{for_class},
- method_metaclass_roles => [ 'Foo::Meta::Role', ],
+
+ return Moose::Util::MetaRole::apply_metaroles(
+ for => $p{for_class},
+ role_metaroles => { method => ['Foo::Meta::Role'] },
);
}
}
+
{
package Role::Baz;
sub bla {}
}
+
{
package My::Class12;
with( 'Role::Baz' );
}
+
{
ok(
My::Class12->meta->does_role( 'Role::Baz' ),
'role applied'
);
+
my $method = My::Class12->meta->get_method( 'bla' );
ok(
$method->meta->does_role( 'Foo::Meta::Role' ),
package Parent;
use Moose;
- Moose::Util::MetaRole::apply_metaclass_roles(
- for_class => __PACKAGE__,
- constructor_class_roles => ['Role::Foo'],
+ Moose::Util::MetaRole::apply_metaroles(
+ for => __PACKAGE__,
+ class_metaroles => { constructor => ['Role::Foo'] },
);
}
}
{
- Moose::Util::MetaRole::apply_metaclass_roles(
- for_class => 'My::Class',
- metaclass_roles => ['Role::Foo'],
+ Moose::Util::MetaRole::apply_metaroles(
+ for => 'My::Class',
+ class_metaroles => { class => ['Role::Foo'] },
);
ok( My::Class->meta()->meta()->does_role('Role::Foo'),
'apply Role::Foo to My::Class->meta()' );
has_superclass( My::Class->meta(), 'My::Meta::Class',
- 'apply_metaclass_roles works with metaclass.pm' );
+ 'apply_metaroles works with metaclass.pm' );
}
{
- Moose::Util::MetaRole::apply_metaclass_roles(
- for_class => 'My::Class2',
- attribute_metaclass_roles => ['Role::Foo'],
- method_metaclass_roles => ['Role::Foo'],
- instance_metaclass_roles => ['Role::Foo'],
+ Moose::Util::MetaRole::apply_metaroles(
+ for => 'My::Class2',
+ class_metaroles => {
+ attribute => ['Role::Foo'],
+ method => ['Role::Foo'],
+ instance => ['Role::Foo'],
+ },
);
ok( My::Class2->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
use Moose;
extends 'Baz';
- Moose::Util::MetaRole::apply_metaclass_roles(
- for_class => __PACKAGE__,
- metaclass_roles => ['Role::Foo'],
+ Moose::Util::MetaRole::apply_metaroles(
+ for => __PACKAGE__,
+ class_metaroles => { class => ['Role::Foo'] },
);
}
use Moose;
- Moose::Util::MetaRole::apply_metaclass_roles(
- for_class => __PACKAGE__,
- metaclass_roles => ['Role::Foo'],
+ Moose::Util::MetaRole::apply_metaroles(
+ for => __PACKAGE__,
+ class_metaroles => { class => ['Role::Foo'] },
);
}
::lives_ok { extends 'Foo::Sub' } 'error_class differs by role so incompat is handled';
- Moose::Util::MetaRole::apply_metaclass_roles(
- for_class => __PACKAGE__,
- error_class_roles => ['Role::Foo'],
+ Moose::Util::MetaRole::apply_metaroles(
+ for => __PACKAGE__,
+ class_metaroles => { error => ['Role::Foo'] },
);
}
Moose::Exporter->setup_import_methods(
metaclass_roles => ['Foo::Trait::Class'],
+ role_metaclass_roles => ['Foo::Trait::Class'],
attribute_metaclass_roles => ['Foo::Trait::Attribute'],
base_class_roles => ['Foo::Role::Base'],
);
use Moose::Role ();
use Moose::Exporter;
- my ($import, $unimport, $init_meta) =
- Moose::Exporter->build_import_methods(
- also => 'Moose::Role',
- metaclass_roles => ['Foo::Trait::Class'],
- attribute_metaclass_roles => ['Foo::Trait::Attribute'],
- base_class_roles => ['Foo::Role::Base'],
- install => [qw(import unimport)],
+ my ( $import, $unimport, $init_meta )
+ = Moose::Exporter->build_import_methods(
+ also => 'Moose::Role',
+ role_metaroles => {
+ role => ['Foo::Trait::Class'],
+ attribute => ['Foo::Trait::Attribute'],
+ },
+ install => [qw(import unimport)],
);
sub init_meta {
around apply_params => sub {
my ( $next, $self, @args ) = @_;
- return Moose::Util::MetaRole::apply_metaclass_roles(
- for_class => $self->$next(@args),
- application_to_class_class_roles =>
- ['CustomApplication::Composite::ToClass'],
- application_to_role_class_roles =>
- ['CustomApplication::Composite::ToRole'],
- application_to_instance_class_roles =>
- ['CustomApplication::Composite::ToInstance'],
+ return Moose::Util::MetaRole::apply_metaroles(
+ for => $self->$next(@args),
+ role_metaroles => {
+ application_to_class =>
+ ['CustomApplication::Composite::ToClass'],
+ application_to_role =>
+ ['CustomApplication::Composite::ToRole'],
+ application_to_instance =>
+ ['CustomApplication::Composite::ToInstance'],
+ },
);
};
}
sub init_meta {
my ( $self, %options ) = @_;
- return Moose::Util::MetaRole::apply_metaclass_roles(
- for_class => Moose::Role->init_meta(%options),
- metaclass_roles => ['Role::WithCustomApplication'],
- application_to_class_class_roles =>
- ['CustomApplication::ToClass'],
- application_to_role_class_roles => ['CustomApplication::ToRole'],
- application_to_instance_class_roles =>
- ['CustomApplication::ToInstance'],
+ return Moose::Util::MetaRole::apply_metaroles(
+ for_class => Moose::Role->init_meta(%options),
+ role_metaroles => {
+ role => ['Role::WithCustomApplication'],
+ application_to_class =>
+ ['CustomApplication::ToClass'],
+ application_to_role => ['CustomApplication::ToRole'],
+ application_to_instance =>
+ ['CustomApplication::ToInstance'],
+ },
);
}
}
--- /dev/null
+#!/usr/bin/perl
+
+# This is a copy of 015_metarole.t taken on 01/01/2010. It provides a
+# comprehensive test of backwards compatibility in the MetaRole API.
+
+use strict;
+use warnings;
+
+use lib 't/lib', 'lib';
+
+use Test::More;
+use Test::Exception;
+
+use Moose::Util::MetaRole;
+
+
+{
+ package My::Meta::Class;
+ use Moose;
+ extends 'Moose::Meta::Class';
+}
+
+{
+ package Role::Foo;
+ use Moose::Role;
+ has 'foo' => ( is => 'ro', default => 10 );
+}
+
+{
+ package My::Class;
+
+ use Moose;
+}
+
+{
+ package My::Role;
+ use Moose::Role;
+}
+
+{
+ Moose::Util::MetaRole::apply_metaclass_roles(
+ for_class => My::Class->meta,
+ metaclass_roles => ['Role::Foo'],
+ );
+
+ ok( My::Class->meta()->meta()->does_role('Role::Foo'),
+ 'apply Role::Foo to My::Class->meta()' );
+ is( My::Class->meta()->foo(), 10,
+ '... and call foo() on that meta object' );
+}
+
+{
+ Moose::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class',
+ attribute_metaclass_roles => ['Role::Foo'],
+ );
+
+ ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
+ q{apply Role::Foo to My::Class->meta()'s attribute metaclass} );
+ ok( My::Class->meta()->meta()->does_role('Role::Foo'),
+ '... My::Class->meta() still does Role::Foo' );
+
+ My::Class->meta()->add_attribute( 'size', is => 'ro' );
+ is( My::Class->meta()->get_attribute('size')->foo(), 10,
+ '... call foo() on an attribute metaclass object' );
+}
+
+{
+ Moose::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class',
+ method_metaclass_roles => ['Role::Foo'],
+ );
+
+ ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
+ q{apply Role::Foo to My::Class->meta()'s method metaclass} );
+ ok( My::Class->meta()->meta()->does_role('Role::Foo'),
+ '... My::Class->meta() still does Role::Foo' );
+ ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
+ q{... My::Class->meta()'s attribute metaclass still does Role::Foo} );
+
+ My::Class->meta()->add_method( 'bar' => sub { 'bar' } );
+ is( My::Class->meta()->get_method('bar')->foo(), 10,
+ '... call foo() on a method metaclass object' );
+}
+
+{
+ Moose::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class',
+ wrapped_method_metaclass_roles => ['Role::Foo'],
+ );
+
+ ok( My::Class->meta()->wrapped_method_metaclass()->meta()->does_role('Role::Foo'),
+ q{apply Role::Foo to My::Class->meta()'s wrapped method metaclass} );
+ ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
+ '... My::Class->meta() still does Role::Foo' );
+ ok( My::Class->meta()->meta()->does_role('Role::Foo'),
+ '... My::Class->meta() still does Role::Foo' );
+ ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
+ q{... My::Class->meta()'s attribute metaclass still does Role::Foo} );
+
+ My::Class->meta()->add_after_method_modifier( 'bar' => sub { 'bar' } );
+ is( My::Class->meta()->get_method('bar')->foo(), 10,
+ '... call foo() on a wrapped method metaclass object' );
+}
+
+{
+ Moose::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class',
+ instance_metaclass_roles => ['Role::Foo'],
+ );
+
+ ok( My::Class->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
+ q{apply Role::Foo to My::Class->meta()'s instance metaclass} );
+ ok( My::Class->meta()->meta()->does_role('Role::Foo'),
+ '... My::Class->meta() still does Role::Foo' );
+ ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
+ q{... My::Class->meta()'s attribute metaclass still does Role::Foo} );
+ ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
+ q{... My::Class->meta()'s method metaclass still does Role::Foo} );
+
+ is( My::Class->meta()->get_meta_instance()->foo(), 10,
+ '... call foo() on an instance metaclass object' );
+}
+
+{
+ Moose::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class',
+ constructor_class_roles => ['Role::Foo'],
+ );
+
+ ok( My::Class->meta()->constructor_class()->meta()->does_role('Role::Foo'),
+ q{apply Role::Foo to My::Class->meta()'s constructor class} );
+ ok( My::Class->meta()->meta()->does_role('Role::Foo'),
+ '... My::Class->meta() still does Role::Foo' );
+ ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
+ q{... My::Class->meta()'s attribute metaclass still does Role::Foo} );
+ ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
+ q{... My::Class->meta()'s method metaclass still does Role::Foo} );
+ ok( My::Class->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
+ q{... My::Class->meta()'s instance metaclass still does Role::Foo} );
+
+ # Actually instantiating the constructor class is too freaking hard!
+ ok( My::Class->meta()->constructor_class()->can('foo'),
+ '... constructor class has a foo method' );
+}
+
+{
+ Moose::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class',
+ destructor_class_roles => ['Role::Foo'],
+ );
+
+ ok( My::Class->meta()->destructor_class()->meta()->does_role('Role::Foo'),
+ q{apply Role::Foo to My::Class->meta()'s destructor class} );
+ ok( My::Class->meta()->meta()->does_role('Role::Foo'),
+ '... My::Class->meta() still does Role::Foo' );
+ ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
+ q{... My::Class->meta()'s attribute metaclass still does Role::Foo} );
+ ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
+ q{... My::Class->meta()'s method metaclass still does Role::Foo} );
+ ok( My::Class->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
+ q{... My::Class->meta()'s instance metaclass still does Role::Foo} );
+ ok( My::Class->meta()->constructor_class()->meta()->does_role('Role::Foo'),
+ q{... My::Class->meta()'s constructor class still does Role::Foo} );
+
+ # same problem as the constructor class
+ ok( My::Class->meta()->destructor_class()->can('foo'),
+ '... destructor class has a foo method' );
+}
+
+{
+ Moose::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Role',
+ application_to_class_class_roles => ['Role::Foo'],
+ );
+
+ ok( My::Role->meta->application_to_class_class->meta->does_role('Role::Foo'),
+ q{apply Role::Foo to My::Role->meta's application_to_class class} );
+
+ is( My::Role->meta->application_to_class_class->new->foo, 10,
+ q{... call foo() on an application_to_class instance} );
+}
+
+{
+ Moose::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Role',
+ application_to_role_class_roles => ['Role::Foo'],
+ );
+
+ ok( My::Role->meta->application_to_role_class->meta->does_role('Role::Foo'),
+ q{apply Role::Foo to My::Role->meta's application_to_role class} );
+ ok( My::Role->meta->application_to_class_class->meta->does_role('Role::Foo'),
+ q{... My::Role->meta's application_to_class class still does Role::Foo} );
+
+ is( My::Role->meta->application_to_role_class->new->foo, 10,
+ q{... call foo() on an application_to_role instance} );
+}
+
+{
+ Moose::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Role',
+ application_to_instance_class_roles => ['Role::Foo'],
+ );
+
+ ok( My::Role->meta->application_to_instance_class->meta->does_role('Role::Foo'),
+ q{apply Role::Foo to My::Role->meta's application_to_instance class} );
+ ok( My::Role->meta->application_to_role_class->meta->does_role('Role::Foo'),
+ q{... My::Role->meta's application_to_role class still does Role::Foo} );
+ ok( My::Role->meta->application_to_class_class->meta->does_role('Role::Foo'),
+ q{... My::Role->meta's application_to_class class still does Role::Foo} );
+
+ is( My::Role->meta->application_to_instance_class->new->foo, 10,
+ q{... call foo() on an application_to_instance instance} );
+}
+
+{
+ Moose::Util::MetaRole::apply_base_class_roles(
+ for_class => 'My::Class',
+ roles => ['Role::Foo'],
+ );
+
+ ok( My::Class->meta()->does_role('Role::Foo'),
+ 'apply Role::Foo to My::Class base class' );
+ is( My::Class->new()->foo(), 10,
+ '... call foo() on a My::Class object' );
+}
+
+{
+ package My::Class2;
+
+ use Moose;
+}
+
+{
+ Moose::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class2',
+ metaclass_roles => ['Role::Foo'],
+ attribute_metaclass_roles => ['Role::Foo'],
+ method_metaclass_roles => ['Role::Foo'],
+ instance_metaclass_roles => ['Role::Foo'],
+ constructor_class_roles => ['Role::Foo'],
+ destructor_class_roles => ['Role::Foo'],
+ );
+
+ ok( My::Class2->meta()->meta()->does_role('Role::Foo'),
+ 'apply Role::Foo to My::Class2->meta()' );
+ is( My::Class2->meta()->foo(), 10,
+ '... and call foo() on that meta object' );
+ ok( My::Class2->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
+ q{apply Role::Foo to My::Class2->meta()'s attribute metaclass} );
+ My::Class2->meta()->add_attribute( 'size', is => 'ro' );
+
+ is( My::Class2->meta()->get_attribute('size')->foo(), 10,
+ '... call foo() on an attribute metaclass object' );
+
+ ok( My::Class2->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
+ q{apply Role::Foo to My::Class2->meta()'s method metaclass} );
+
+ My::Class2->meta()->add_method( 'bar' => sub { 'bar' } );
+ is( My::Class2->meta()->get_method('bar')->foo(), 10,
+ '... call foo() on a method metaclass object' );
+
+ ok( My::Class2->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
+ q{apply Role::Foo to My::Class2->meta()'s instance metaclass} );
+ is( My::Class2->meta()->get_meta_instance()->foo(), 10,
+ '... call foo() on an instance metaclass object' );
+
+ ok( My::Class2->meta()->constructor_class()->meta()->does_role('Role::Foo'),
+ q{apply Role::Foo to My::Class2->meta()'s constructor class} );
+ ok( My::Class2->meta()->constructor_class()->can('foo'),
+ '... constructor class has a foo method' );
+
+ ok( My::Class2->meta()->destructor_class()->meta()->does_role('Role::Foo'),
+ q{apply Role::Foo to My::Class2->meta()'s destructor class} );
+ ok( My::Class2->meta()->destructor_class()->can('foo'),
+ '... destructor class has a foo method' );
+}
+
+
+{
+ package My::Meta;
+
+ use Moose::Exporter;
+ Moose::Exporter->setup_import_methods( also => 'Moose' );
+
+ sub init_meta {
+ shift;
+ my %p = @_;
+
+ Moose->init_meta( %p, metaclass => 'My::Meta::Class' );
+ }
+}
+
+{
+ package My::Class3;
+
+ My::Meta->import();
+}
+
+
+{
+ Moose::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class3',
+ metaclass_roles => ['Role::Foo'],
+ );
+
+ ok( My::Class3->meta()->meta()->does_role('Role::Foo'),
+ 'apply Role::Foo to My::Class3->meta()' );
+ is( My::Class3->meta()->foo(), 10,
+ '... and call foo() on that meta object' );
+ ok( ( grep { $_ eq 'My::Meta::Class' } My::Class3->meta()->meta()->superclasses() ),
+ 'apply_metaclass_roles() does not interfere with metaclass set via Moose->init_meta()' );
+}
+
+{
+ package Role::Bar;
+ use Moose::Role;
+ has 'bar' => ( is => 'ro', default => 200 );
+}
+
+{
+ package My::Class4;
+ use Moose;
+}
+
+{
+ Moose::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class4',
+ metaclass_roles => ['Role::Foo'],
+ );
+
+ ok( My::Class4->meta()->meta()->does_role('Role::Foo'),
+ 'apply Role::Foo to My::Class4->meta()' );
+
+ Moose::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class4',
+ metaclass_roles => ['Role::Bar'],
+ );
+
+ ok( My::Class4->meta()->meta()->does_role('Role::Bar'),
+ 'apply Role::Bar to My::Class4->meta()' );
+ ok( My::Class4->meta()->meta()->does_role('Role::Foo'),
+ '... and My::Class4->meta() still does Role::Foo' );
+}
+
+{
+ package My::Class5;
+ use Moose;
+
+ extends 'My::Class';
+}
+
+{
+ ok( My::Class5->meta()->meta()->does_role('Role::Foo'),
+ q{My::Class5->meta()'s does Role::Foo because it extends My::Class} );
+ ok( My::Class5->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
+ q{My::Class5->meta()'s attribute metaclass also does Role::Foo} );
+ ok( My::Class5->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
+ q{My::Class5->meta()'s method metaclass also does Role::Foo} );
+ ok( My::Class5->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
+ q{My::Class5->meta()'s instance metaclass also does Role::Foo} );
+ ok( My::Class5->meta()->constructor_class()->meta()->does_role('Role::Foo'),
+ q{My::Class5->meta()'s constructor class also does Role::Foo} );
+ ok( My::Class5->meta()->destructor_class()->meta()->does_role('Role::Foo'),
+ q{My::Class5->meta()'s destructor class also does Role::Foo} );
+}
+
+{
+ Moose::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class5',
+ metaclass_roles => ['Role::Bar'],
+ );
+
+ ok( My::Class5->meta()->meta()->does_role('Role::Bar'),
+ q{apply Role::Bar My::Class5->meta()} );
+ ok( My::Class5->meta()->meta()->does_role('Role::Foo'),
+ q{... and My::Class5->meta() still does Role::Foo} );
+}
+
+{
+ package My::Class6;
+ use Moose;
+
+ Moose::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class6',
+ metaclass_roles => ['Role::Bar'],
+ );
+
+ extends 'My::Class';
+}
+
+{
+ ok( My::Class6->meta()->meta()->does_role('Role::Bar'),
+ q{apply Role::Bar My::Class6->meta() before extends} );
+ ok( My::Class6->meta()->meta()->does_role('Role::Foo'),
+ q{... and My::Class6->meta() does Role::Foo because My::Class6 extends My::Class} );
+}
+
+# This is the hack that used to be needed to work around the
+# _fix_metaclass_incompatibility problem. You called extends() (which
+# in turn calls _fix_metaclass_imcompatibility) _before_ you apply
+# more extensions in the subclass. We wabt to make sure this continues
+# to work in the future.
+{
+ package My::Class7;
+ use Moose;
+
+ # In real usage this would go in a BEGIN block so it happened
+ # before apply_metaclass_roles was called by an extension.
+ extends 'My::Class';
+
+ Moose::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class7',
+ metaclass_roles => ['Role::Bar'],
+ );
+}
+
+{
+ ok( My::Class7->meta()->meta()->does_role('Role::Bar'),
+ q{apply Role::Bar My::Class7->meta() before extends} );
+ ok( My::Class7->meta()->meta()->does_role('Role::Foo'),
+ q{... and My::Class7->meta() does Role::Foo because My::Class7 extends My::Class} );
+}
+
+{
+ package My::Class8;
+ use Moose;
+
+ Moose::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class8',
+ metaclass_roles => ['Role::Bar'],
+ attribute_metaclass_roles => ['Role::Bar'],
+ );
+
+ extends 'My::Class';
+}
+
+{
+ ok( My::Class8->meta()->meta()->does_role('Role::Bar'),
+ q{apply Role::Bar My::Class8->meta() before extends} );
+ ok( My::Class8->meta()->meta()->does_role('Role::Foo'),
+ q{... and My::Class8->meta() does Role::Foo because My::Class8 extends My::Class} );
+ ok( My::Class8->meta()->attribute_metaclass->meta()->does_role('Role::Bar'),
+ q{apply Role::Bar to My::Class8->meta()->attribute_metaclass before extends} );
+ ok( My::Class8->meta()->attribute_metaclass->meta()->does_role('Role::Foo'),
+ q{... and My::Class8->meta()->attribute_metaclass does Role::Foo because My::Class8 extends My::Class} );
+}
+
+
+{
+ package My::Class9;
+ use Moose;
+
+ Moose::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class9',
+ attribute_metaclass_roles => ['Role::Bar'],
+ );
+
+ extends 'My::Class';
+}
+
+{
+ ok( My::Class9->meta()->meta()->does_role('Role::Foo'),
+ q{... and My::Class9->meta() does Role::Foo because My::Class9 extends My::Class} );
+ ok( My::Class9->meta()->attribute_metaclass->meta()->does_role('Role::Bar'),
+ q{apply Role::Bar to My::Class9->meta()->attribute_metaclass before extends} );
+ ok( My::Class9->meta()->attribute_metaclass->meta()->does_role('Role::Foo'),
+ q{... and My::Class9->meta()->attribute_metaclass does Role::Foo because My::Class9 extends My::Class} );
+}
+
+# This tests applying meta roles to a metaclass's metaclass. This is
+# completely insane, but is exactly what happens with
+# Fey::Meta::Class::Table. It's a subclass of Moose::Meta::Class
+# itself, and then it _uses_ MooseX::ClassAttribute, so the metaclass
+# for Fey::Meta::Class::Table does a role.
+#
+# At one point this caused a metaclass incompatibility error down
+# below, when we applied roles to the metaclass of My::Class10. It's
+# all madness but as long as the tests pass we're happy.
+{
+ package My::Meta::Class2;
+ use Moose;
+ extends 'Moose::Meta::Class';
+
+ Moose::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Meta::Class2',
+ metaclass_roles => ['Role::Foo'],
+ );
+}
+
+{
+ package My::Object;
+ use Moose;
+ extends 'Moose::Object';
+}
+
+{
+ package My::Meta2;
+
+ use Moose::Exporter;
+ Moose::Exporter->setup_import_methods( also => 'Moose' );
+
+ sub init_meta {
+ shift;
+ my %p = @_;
+
+ Moose->init_meta(
+ %p,
+ metaclass => 'My::Meta::Class2',
+ base_class => 'My::Object',
+ );
+ }
+}
+
+{
+ package My::Class10;
+ My::Meta2->import;
+
+ Moose::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class10',
+ metaclass_roles => ['Role::Bar'],
+ );
+}
+
+{
+ ok( My::Class10->meta()->meta()->meta()->does_role('Role::Foo'),
+ q{My::Class10->meta()->meta() does Role::Foo } );
+ ok( My::Class10->meta()->meta()->does_role('Role::Bar'),
+ q{My::Class10->meta()->meta() does Role::Bar } );
+ ok( My::Class10->meta()->isa('My::Meta::Class2'),
+ q{... and My::Class10->meta still isa(My::Meta::Class2)} );
+ ok( My::Class10->isa('My::Object'),
+ q{... and My::Class10 still isa(My::Object)} );
+}
+
+{
+ package My::Constructor;
+
+ use base 'Moose::Meta::Method::Constructor';
+}
+
+{
+ package My::Class11;
+
+ use Moose;
+
+ __PACKAGE__->meta->constructor_class('My::Constructor');
+
+ Moose::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class11',
+ metaclass_roles => ['Role::Foo'],
+ );
+}
+
+{
+ ok( My::Class11->meta()->meta()->does_role('Role::Foo'),
+ q{My::Class11->meta()->meta() does Role::Foo } );
+ is( My::Class11->meta()->constructor_class, 'My::Constructor',
+ q{... and explicitly set constructor_class value is unchanged)} );
+}
+
+{
+ package ExportsMoose;
+
+ Moose::Exporter->setup_import_methods(
+ also => 'Moose',
+ );
+
+ sub init_meta {
+ shift;
+ my %p = @_;
+ Moose->init_meta(%p);
+ return Moose::Util::MetaRole::apply_metaclass_roles(
+ for_class => $p{for_class},
+ # Causes us to recurse through init_meta, as we have to
+ # load MyMetaclassRole from disk.
+ metaclass_roles => [qw/MyMetaclassRole/],
+ );
+ }
+}
+
+lives_ok {
+ package UsesExportedMoose;
+ ExportsMoose->import;
+} 'import module which loads a role from disk during init_meta';
+
+{
+ package Foo::Meta::Role;
+
+ use Moose::Role;
+}
+{
+ package Foo::Role;
+
+ Moose::Exporter->setup_import_methods(
+ also => 'Moose::Role',
+ );
+
+ sub init_meta {
+ shift;
+ my %p = @_;
+ Moose::Role->init_meta(%p);
+ return Moose::Util::MetaRole::apply_metaclass_roles(
+ for_class => $p{for_class},
+ method_metaclass_roles => [ 'Foo::Meta::Role', ],
+ );
+ }
+}
+{
+ package Role::Baz;
+
+ Foo::Role->import;
+
+ sub bla {}
+}
+{
+ package My::Class12;
+
+ use Moose;
+
+ with( 'Role::Baz' );
+}
+{
+ ok(
+ My::Class12->meta->does_role( 'Role::Baz' ),
+ 'role applied'
+ );
+ my $method = My::Class12->meta->get_method( 'bla' );
+ ok(
+ $method->meta->does_role( 'Foo::Meta::Role' ),
+ 'method_metaclass_role applied'
+ );
+}
+
+{
+ package Parent;
+ use Moose;
+
+ Moose::Util::MetaRole::apply_metaclass_roles(
+ for_class => __PACKAGE__,
+ constructor_class_roles => ['Role::Foo'],
+ );
+}
+
+{
+ package Child;
+
+ use Moose;
+ extends 'Parent';
+}
+
+{
+ ok(
+ Parent->meta->constructor_class->meta->can('does_role')
+ && Parent->meta->constructor_class->meta->does_role('Role::Foo'),
+ 'Parent constructor class has metarole from Parent'
+ );
+
+TODO:
+ {
+ local $TODO
+ = 'Moose does not see that the child differs from the parent because it only checks the class and instance metaclasses do determine compatibility';
+ ok(
+ Child->meta->constructor_class->meta->can('does_role')
+ && Child->meta->constructor_class->meta->does_role(
+ 'Role::Foo'),
+ 'Child constructor class has metarole from Parent'
+ );
+ }
+}
+
+done_testing;
isa_ok( $gorch, "Moose::Meta::Role" );
ok( $gorch->has_attribute("attr"), "has attribute 'attr'" );
-
-{
- local $TODO = "role attribute isn't a meta attribute yet";
- isa_ok( $gorch->get_attribute("attr"), "Moose::Meta::Attribute" );
-}
+isa_ok( $gorch->get_attribute("attr"), "Moose::Meta::Role::Attribute" );
req_or_has($gorch, "gorch_method");
ok( $gorch->has_method("gorch_method"), "has_method gorch_method" );
isa_ok( $robot, "Moose::Meta::Role" );
ok( $robot->has_attribute("twist"), "has attr 'twist'" );
-
-{
- local $TODO = "role attribute isn't a meta attribute yet";
- isa_ok( $robot->get_attribute("twist"), "Moose::Meta::Attribute" );
-}
+isa_ok( $robot->get_attribute("twist"), "Moose::Meta::Role::Attribute" );
{
req_or_has($robot, "twist");
construct_instance
create_error
raise_error
+ reinitialize
superclasses
)
],
'Moose::Meta::Role' => [
qw( alias_method
get_method_modifier_list
+ reinitialize
reset_package_cache_flag
update_package_cache_flag
wrap_method_body
)
],
+ 'Moose::Meta::Mixin::AttributeCore' => ['.+'],
'Moose::Meta::Role::Composite' =>
[ 'get_method', 'get_method_list', 'has_method', 'add_method' ],
'Moose::Role' => [
'Moose::Meta::TypeConstraint::Role' => [qw( equals is_a_type_of )],
'Moose::Meta::TypeConstraint::Union' => ['compile_type_constraint'],
'Moose::Util' => ['add_method_modifier'],
+ 'Moose::Util::MetaRole' => ['apply_metaclass_roles'],
'Moose::Util::TypeConstraints' => ['find_or_create_type_constraint'],
);
MetaObject
metaprogrammer
metarole
+metaroles
metatraits
mixins
MooseX
projects / gitmo/Moose.git / commitdiff