X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FMeta%2FRole.pm;h=c251b659bb03f2a5a823803a0fce19d829f4e9f1;hb=2bd71c26367a49e273c365db94da1f515230150a;hp=f503d5af2b9d1fdc6322d6bc3d63c00128fdcf45;hpb=14bda29327e955a043700489d603b1718986d41d;p=gitmo%2FMoose.git

diff --git a/lib/Moose/Meta/Role.pm b/lib/Moose/Meta/Role.pm
index f503d5a..c251b65 100644
--- a/lib/Moose/Meta/Role.pm
+++ b/lib/Moose/Meta/Role.pm
@@ -82,7 +82,8 @@ foreach my $action (
     # create the attribute
     $META->add_attribute($action->{name} => (
         reader  => $attr_reader,
-        default => sub { {} }
+        default => sub { {} },
+        Class::MOP::_definition_context(),
     ));
 
     # create some helper methods
@@ -121,64 +122,63 @@ $META->add_attribute(
     '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
 sub initialize {
     my $class = shift;
-    my $pkg   = shift;
-
-    if (defined(my $meta = Class::MOP::get_metaclass_by_name($pkg))) {
-        return $meta;
-    }
-
-    my %options = @_;
-
-    my $meta = $class->SUPER::initialize(
-        $pkg,
-        'attribute_metaclass' => 'Moose::Meta::Role::Attribute',
-        %options,
-    );
-
-    Class::MOP::weaken_metaclass($pkg) if $options{weaken};
-
-    return $meta;
+    my @args = @_;
+    unshift @args, 'package' if @args % 2;
+    my %opts = @args;
+    my $package = delete $opts{package};
+    return Class::MOP::get_metaclass_by_name($package)
+        || $class->SUPER::initialize($package,
+                'attribute_metaclass' => 'Moose::Meta::Role::Attribute',
+                %opts,
+            );
 }
 
 sub reinitialize {
@@ -299,7 +299,8 @@ foreach my $modifier_type (qw[ before around after ]) {
     # 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 ...
@@ -344,7 +345,8 @@ foreach my $modifier_type (qw[ before around after ]) {
 
 $META->add_attribute('override_method_modifiers' => (
     reader  => 'get_override_method_modifiers_map',
-    default => sub { {} }
+    default => sub { {} },
+    Class::MOP::_definition_context(),
 ));
 
 # NOTE:
@@ -389,7 +391,8 @@ sub _meta_method_class { 'Moose::Meta::Method::Meta' }
 
 $META->add_attribute('roles' => (
     reader  => 'get_roles',
-    default => sub { [] }
+    default => sub { [] },
+    Class::MOP::_definition_context(),
 ));
 
 sub add_role {
@@ -449,29 +452,6 @@ sub apply {
 
     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.'
-        );
-    }
-
     if ( exists $args{'-excludes'} ) {
         # I wish we had coercion here :)
         $args{'-excludes'} = (
@@ -516,9 +496,11 @@ sub _role_for_combination {
 }
 
 sub create {
-    my ( $role, $package_name, %options ) = @_;
+    my $class = shift;
+    my @args = @_;
 
-    $options{package} = $package_name;
+    unshift @args, 'package' if @args % 2 == 1;
+    my %options = @args;
 
     (ref $options{attributes} eq 'HASH')
         || confess "You must pass a HASH ref of attributes"
@@ -528,40 +510,41 @@ sub create {
         || confess "You must pass a HASH ref of methods"
             if exists $options{methods};
 
-    $options{meta_name} = 'meta'
-        unless exists $options{meta_name};
-
-    my (%initialize_options) = %options;
-    delete @initialize_options{qw(
-        package
-        attributes
-        methods
-        meta_name
-        version
-        authority
-    )};
+    (ref $options{roles} eq 'ARRAY')
+        || confess "You must pass an ARRAY ref of roles"
+            if exists $options{roles};
 
-    my $meta = $role->initialize( $package_name => %initialize_options );
+    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}
+                         ? delete $options{meta_name}
+                         : 'meta';
 
-    $meta->_instantiate_module( $options{version}, $options{authority} );
+    my $meta = $class->SUPER::create($package => %options);
 
-    $meta->_add_meta_method($options{meta_name})
-        if defined $options{meta_name};
+    $meta->_add_meta_method($meta_name)
+        if defined $meta_name;
 
-    if (exists $options{attributes}) {
-        foreach my $attribute_name (keys %{$options{attributes}}) {
-            my $attr = $options{attributes}->{$attribute_name};
+    if (defined $attributes) {
+        foreach my $attribute_name (keys %{$attributes}) {
+            my $attr = $attributes->{$attribute_name};
             $meta->add_attribute(
                 $attribute_name => blessed $attr ? $attr : %{$attr} );
         }
     }
 
-    if (exists $options{methods}) {
-        foreach my $method_name (keys %{$options{methods}}) {
-            $meta->add_method($method_name, $options{methods}->{$method_name});
+    if (defined $methods) {
+        foreach my $method_name (keys %{$methods}) {
+            $meta->add_method($method_name, $methods->{$method_name});
         }
     }
 
+    if ($roles) {
+        Moose::Util::apply_all_roles($meta, @$roles);
+    }
+
     return $meta;
 }
 
@@ -578,65 +561,59 @@ sub consumers {
     return @consumers;
 }
 
-# anonymous roles. most of it is copied straight out of Class::MOP::Class.
-# an intrepid hacker might find great riches if he unifies this code with that
-# code in Class::MOP::Module or Class::MOP::Package
-{
-    # NOTE:
-    # this should be sufficient, if you have a
-    # use case where it is not, write a test and
-    # I will change it.
-    my $ANON_ROLE_SERIAL = 0;
+# XXX: something more intelligent here?
+sub _anon_package_prefix { 'Moose::Meta::Role::__ANON__::SERIAL::' }
 
-    # NOTE:
-    # we need a sufficiently annoying prefix
-    # this should suffice for now, this is
-    # used in a couple of places below, so
-    # need to put it up here for now.
-    my $ANON_ROLE_PREFIX = 'Moose::Meta::Role::__ANON__::SERIAL::';
-
-    sub is_anon_role {
-        my $self = shift;
-        no warnings 'uninitialized';
-        $self->name =~ /^$ANON_ROLE_PREFIX/;
-    }
+sub create_anon_role { shift->create_anon(@_) }
+sub is_anon_role     { shift->is_anon(@_)     }
 
-    sub create_anon_role {
-        my ($role, %options) = @_;
-        $options{weaken} = 1 unless exists $options{weaken};
-        my $package_name = $ANON_ROLE_PREFIX . ++$ANON_ROLE_SERIAL;
-        return $role->create($package_name, %options);
-    }
+sub _anon_cache_key {
+    my $class = shift;
+    my %options = @_;
 
-    # NOTE:
-    # this will only get called for
-    # anon-roles, all other calls
-    # are assumed to occur during
-    # global destruction and so don't
-    # really need to be handled explicitly
-    sub DESTROY {
-        my $self = shift;
-
-        return if in_global_destruction(); # it'll happen soon anyway and this just makes things more complicated
-
-        no warnings 'uninitialized';
-        return unless $self->name =~ /^$ANON_ROLE_PREFIX/;
-
-        # Moose does a weird thing where it replaces the metaclass for
-        # class when fixing metaclass incompatibility. In that case,
-        # we don't want to clean out the namespace now. We can detect
-        # that because Moose will explicitly update the singleton
-        # cache in Class::MOP.
-        my $current_meta = Class::MOP::get_metaclass_by_name($self->name);
-        return if $current_meta ne $self;
-
-        my ($serial_id) = ($self->name =~ /^$ANON_ROLE_PREFIX(\d+)/);
-        no strict 'refs';
-        foreach my $key (keys %{$ANON_ROLE_PREFIX . $serial_id}) {
-            delete ${$ANON_ROLE_PREFIX . $serial_id}{$key};
+    # 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) . '>';
         }
-        delete ${'main::' . $ANON_ROLE_PREFIX}{$serial_id . '::'};
+
+        push @role_keys, $key;
     }
+
+    # Makes something like Role|Role::1
+    return join('|', sort @role_keys);
 }
 
 #####################################################################
@@ -759,7 +736,7 @@ __END__
 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