-
package Moose::Meta::Role;
use strict;
use warnings;
use metaclass;
+use Class::Load qw(load_class);
use Scalar::Util 'blessed';
-use Carp 'confess';
use Devel::GlobalDestruction 'in_global_destruction';
use Moose::Meta::Class;
# NOTE:
# since roles are lazy, we hold all the attributes
-# of the individual role in 'statis' until which
+# of the individual role in 'stasis' until which
# time when it is applied to a class. This means
# keeping a lot of things in hash maps, so we are
# using a little of that meta-programmin' magic
# create the attribute
$META->add_attribute($action->{name} => (
reader => $attr_reader,
- default => sub { {} }
+ default => sub { {} },
+ Class::MOP::_definition_context(),
));
# create some helper methods
'method_metaclass',
reader => 'method_metaclass',
default => 'Moose::Meta::Role::Method',
+ Class::MOP::_definition_context(),
);
$META->add_attribute(
'required_method_metaclass',
reader => 'required_method_metaclass',
default => 'Moose::Meta::Role::Method::Required',
+ Class::MOP::_definition_context(),
);
$META->add_attribute(
'conflicting_method_metaclass',
reader => 'conflicting_method_metaclass',
default => 'Moose::Meta::Role::Method::Conflicting',
+ Class::MOP::_definition_context(),
);
$META->add_attribute(
'application_to_class_class',
reader => 'application_to_class_class',
default => 'Moose::Meta::Role::Application::ToClass',
+ Class::MOP::_definition_context(),
);
$META->add_attribute(
'application_to_role_class',
reader => 'application_to_role_class',
default => 'Moose::Meta::Role::Application::ToRole',
+ Class::MOP::_definition_context(),
);
$META->add_attribute(
'application_to_instance_class',
reader => 'application_to_instance_class',
default => 'Moose::Meta::Role::Application::ToInstance',
+ Class::MOP::_definition_context(),
);
$META->add_attribute(
'applied_attribute_metaclass',
reader => 'applied_attribute_metaclass',
default => 'Moose::Meta::Attribute',
+ Class::MOP::_definition_context(),
);
# More or less copied from Moose::Meta::Class
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" );
+ Moose::Util::throw( "Cannot add a $class as an attribute to a role" );
}
elsif (!blessed($_[0]) && defined($_[0]) && $_[0] =~ /^\+(.*)/) {
- Moose->throw_error( "has '+attr' is not supported in roles" );
+ Moose::Util::throw( "has '+attr' is not supported in roles" );
}
return $self->SUPER::add_attribute(@_);
# create the attribute ...
$META->add_attribute("${modifier_type}_method_modifiers" => (
reader => $attr_reader,
- default => sub { {} }
+ default => sub { {} },
+ Class::MOP::_definition_context(),
));
# and some helper methods ...
$META->add_attribute('override_method_modifiers' => (
reader => 'get_override_method_modifiers_map',
- default => sub { {} }
+ default => sub { {} },
+ Class::MOP::_definition_context(),
));
# NOTE:
sub add_override_method_modifier {
my ($self, $method_name, $method) = @_;
(!$self->has_method($method_name))
- || Moose->throw_error("Cannot add an override of method '$method_name' " .
+ || Moose::Util::throw("Cannot add an override of method '$method_name' " .
"because there is a local version of '$method_name'");
$self->get_override_method_modifiers_map->{$method_name} = $method;
}
$META->add_attribute('roles' => (
reader => 'get_roles',
- default => sub { [] }
+ default => sub { [] },
+ Class::MOP::_definition_context(),
));
sub add_role {
my ($self, $role) = @_;
(blessed($role) && $role->isa('Moose::Meta::Role'))
- || Moose->throw_error("Roles must be instances of Moose::Meta::Role");
+ || Moose::Util::throw("Roles must be instances of Moose::Meta::Role");
push @{$self->get_roles} => $role;
$self->reset_package_cache_flag;
}
sub does_role {
my ($self, $role) = @_;
(defined $role)
- || Moose->throw_error("You must supply a role name to look for");
+ || Moose::Util::throw("You must supply a role name to look for");
my $role_name = blessed $role ? $role->name : $role;
# if we are it,.. then return true
return 1 if $role_name eq $self->name;
my ($self, $other, %args) = @_;
(blessed($other))
- || Moose->throw_error("You must pass in an blessed instance");
+ || Moose::Util::throw("You must pass in an blessed instance");
my $application_class;
if ($other->isa('Moose::Meta::Role')) {
$application_class = $self->application_to_instance_class;
}
- Class::MOP::load_class($application_class);
-
- my $deprecation_check = 0;
-
- if ( exists $args{excludes} && !exists $args{'-excludes'} ) {
- $args{'-excludes'} = delete $args{excludes};
- $deprecation_check = 1;
- }
- if ( exists $args{alias} && !exists $args{'-alias'} ) {
- $args{'-alias'} = delete $args{alias};
- $deprecation_check = 1;
- }
-
- if ( $deprecation_check ) {
- Moose::Deprecated::deprecated(
- feature => 'alias or excludes',
- message =>
- 'The alias and excludes options for role application'.
- ' have been renamed -alias and -excludes'.
- " (${\$other->name} is consuming ${\$self->name}".
- " - do you need to upgrade ${\$other->name}?).".
- ' This will be an error in Moose 2.0200.'
- );
- }
+ load_class($application_class);
if ( exists $args{'-excludes'} ) {
# I wish we had coercion here :)
my %options = @args;
(ref $options{attributes} eq 'HASH')
- || confess "You must pass a HASH ref of attributes"
+ || Moose::Util::throw "You must pass a HASH ref of attributes"
if exists $options{attributes};
(ref $options{methods} eq 'HASH')
- || confess "You must pass a HASH ref of methods"
+ || Moose::Util::throw "You must pass a HASH ref of methods"
if exists $options{methods};
+ (ref $options{roles} eq 'ARRAY')
+ || Moose::Util::throw "You must pass an ARRAY ref of roles"
+ if exists $options{roles};
+
my $package = delete $options{package};
+ my $roles = delete $options{roles};
my $attributes = delete $options{attributes};
my $methods = delete $options{methods};
my $meta_name = exists $options{meta_name}
}
}
+ if ($roles) {
+ Moose::Util::apply_all_roles($meta, @$roles);
+ }
+
return $meta;
}
sub _anon_cache_key {
my $class = shift;
my %options = @_;
+
+ # XXX fix this duplication (see MMC::_anon_cache_key
+ my $roles = Data::OptList::mkopt(($options{roles} || []), {
+ moniker => 'role',
+ val_test => sub { ref($_[0]) eq 'HASH' },
+ });
+
+ my @role_keys;
+ for my $role_spec (@$roles) {
+ my ($role, $params) = @$role_spec;
+ $params = { %$params };
+
+ my $key = blessed($role) ? $role->name : $role;
+
+ if ($params && %$params) {
+ my $alias = delete $params->{'-alias'}
+ || delete $params->{'alias'}
+ || {};
+ my $excludes = delete $params->{'-excludes'}
+ || delete $params->{'excludes'}
+ || [];
+ $excludes = [$excludes] unless ref($excludes) eq 'ARRAY';
+
+ if (%$params) {
+ warn "Roles with parameters cannot be cached. Consider "
+ . "applying the parameters before calling "
+ . "create_anon_class, or using 'weaken => 0' instead";
+ return;
+ }
+
+ my $alias_key = join('%',
+ map { $_ => $alias->{$_} } sort keys %$alias
+ );
+ my $excludes_key = join('%',
+ sort @$excludes
+ );
+ $key .= '<' . join('+', 'a', $alias_key, 'e', $excludes_key) . '>';
+ }
+
+ push @role_keys, $key;
+ }
+
# Makes something like Role|Role::1
- return join '=' => (
- join( '|', sort @{ $options{roles} || [] } ),
- );
+ return join('|', sort @role_keys);
}
#####################################################################
This class is a subclass of L<Class::MOP::Module> that provides
additional Moose-specific functionality.
-It's API looks a lot like L<Moose::Meta::Class>, but internally it
+Its API looks a lot like L<Moose::Meta::Class>, but internally it
implements many things differently. This may change in the future.
=head1 INHERITANCE
=back
+=head2 Overload introspection and creation
+
+The methods for dealing with a role's overloads are all identical in API
+and behavior to the same methods in L<Class::MOP::Class>. Note that these are
+not particularly useful (yet), because overloads do not participate in role
+composition.
+
+=over 4
+
+=item B<< $metarole->is_overloaded >>
+
+=item B<< $metarole->get_overloaded_operator($op) >>
+
+=item B<< $metarole->has_overloaded_operator($op) >>
+
+=item B<< $metarole->get_overload_list >>
+
+=item B<< $metarole->get_all_overloaded_operators >>
+
+=item B<< $metarole->add_overloaded_operator($op, $impl) >>
+
+=item B<< $metarole->remove_overloaded_operator($op) >>
+
+=back
+
=head2 Required methods
=over 4