use Carp 'confess';
use Devel::GlobalDestruction 'in_global_destruction';
-our $VERSION = '1.14';
-$VERSION = eval $VERSION;
-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::Meta::Method::Meta;
use Moose::Util qw( ensure_all_roles );
use Class::MOP::MiniTrait;
default => 'Moose::Meta::Role::Application::ToInstance',
);
+$META->add_attribute(
+ 'applied_attribute_metaclass',
+ reader => 'applied_attribute_metaclass',
+ default => 'Moose::Meta::Attribute',
+);
+
# 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(
+
+ 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;
}
sub reinitialize {
application_to_class_class
application_to_role_class
application_to_instance_class
+ applied_attribute_metaclass
);
}
- return $self->SUPER::reinitialize(
+ my %options = @_;
+ $options{weaken} = Class::MOP::metaclass_is_weak($meta->name)
+ if !exists $options{weaken}
+ && blessed($meta)
+ && $meta->isa('Moose::Meta::Role');
+
+ # don't need to remove generated metaobjects here yet, since we don't
+ # yet generate anything in roles. this may change in the future though...
+ # keep an eye on that
+ my $new_meta = $self->SUPER::reinitialize(
$pkg,
%existing_classes,
- @_,
+ %options,
);
+ $new_meta->_restore_metaobjects_from($meta)
+ if $meta && $meta->isa('Moose::Meta::Role');
+ return $new_meta;
+}
+
+sub _restore_metaobjects_from {
+ my $self = shift;
+ my ($old_meta) = @_;
+
+ $self->_restore_metamethods_from($old_meta);
+ $self->_restore_metaattributes_from($old_meta);
+
+ for my $role ( @{ $old_meta->get_roles } ) {
+ $self->add_role($role);
+ }
}
sub add_attribute {
keys %{$self->$accessor};
}
-sub reset_package_cache_flag { (shift)->{'_package_cache_flag'} = undef }
-sub update_package_cache_flag {
- my $self = shift;
- $self->{'_package_cache_flag'} = Class::MOP::check_package_cache_flag($self->name);
-}
-
-
+sub _meta_method_class { 'Moose::Meta::Method::Meta' }
## ------------------------------------------------------------------
## subroles
}
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'} = (
+ ref $args{'-excludes'} eq 'ARRAY'
+ ? $args{'-excludes'}
+ : [ $args{'-excludes'} ]
+ );
+ }
+
return $application_class->new(%args)->apply($self, $other, \%args);
}
|| 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
)};
$meta->_instantiate_module( $options{version}, $options{authority} );
- # FIXME totally lame
- $meta->add_method('meta' => sub {
- $role->initialize(ref($_[0]) || $_[0]);
- });
+ $meta->_add_meta_method($options{meta_name})
+ if defined $options{meta_name};
if (exists $options{attributes}) {
foreach my $attribute_name (keys %{$options{attributes}}) {
}
}
- Class::MOP::weaken_metaclass($meta->name)
- if $meta->is_anon_role;
-
return $meta;
}
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);
}
no warnings 'uninitialized';
return unless $self->name =~ /^$ANON_ROLE_PREFIX/;
- # XXX: is this necessary for us? I don't understand what it's doing
- # -sartak
-
# 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 $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';
1;
+# ABSTRACT: The Moose Role metaclass
+
__END__
=pod
-=head1 NAME
-
-Moose::Meta::Role - The Moose Role metaclass
-
=head1 DESCRIPTION
This class is a subclass of L<Class::MOP::Module> that provides
See L<Moose/BUGS> for details on reporting bugs.
-=head1 AUTHOR
-
-Stevan Little E<lt>stevan@iinteractive.comE<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright 2006-2010 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
projects / gitmo/Moose.git / blobdiff