use Carp qw( confess );
use Class::MOP;
use List::MoreUtils qw( first_index uniq );
+use Moose::Util::MetaRole;
use Sub::Exporter;
$did_init_meta = 1;
}
- if ($did_init_meta) {
+ if ( $did_init_meta && @{$traits} ) {
_apply_meta_traits( $CALLER, $traits );
}
- elsif ( $traits && @{$traits} ) {
+ elsif ( @{$traits} ) {
confess
"Cannot provide traits when $class does not have an init_meta() method";
}
sub _strip_traits {
my $idx = first_index { $_ eq '-traits' } @_;
- return ( undef, @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
+ return ( [], @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
my $traits = $_[ $idx + 1 ];
sub _apply_meta_traits {
my ( $class, $traits ) = @_;
- return
- unless $traits && @$traits;
+ return unless @{$traits};
my $meta = $class->meta();
'Cannot determine metaclass type for trait application . Meta isa '
. ref $meta;
- # We can only call does_role() on Moose::Meta::Class objects, and
- # we can only do that on $meta->meta() if it has already had at
- # least one trait applied to it. By default $meta->meta() returns
- # a Class::MOP::Class object (not a Moose::Meta::Class).
- my @traits = grep {
- $meta->meta()->can('does_role')
- ? not $meta->meta()->does_role($_)
- : 1
- }
- map { Moose::Util::resolve_metatrait_alias( $type => $_ ) } @$traits;
+ my @resolved_traits
+ = map { Moose::Util::resolve_metatrait_alias( $type => $_ ) }
+ @$traits;
- return unless @traits;
+ return unless @resolved_traits;
- Moose::Util::apply_all_roles_with_method( $meta,
- 'apply_to_metaclass_instance', \@traits );
+ Moose::Util::MetaRole::apply_metaclass_roles(
+ for_class => $class,
+ metaclass_roles => \@resolved_traits,
+ );
}
sub _get_caller {
+++ /dev/null
-package Moose::Meta::Role::Application::ToMetaclassInstance;
-
-use strict;
-use warnings;
-use metaclass;
-
-use Scalar::Util 'blessed';
-
-our $VERSION = '0.55_01';
-$VERSION = eval $VERSION;
-our $AUTHORITY = 'cpan:STEVAN';
-
-use base 'Moose::Meta::Role::Application::ToClass';
-
-__PACKAGE__->meta->add_attribute('rebless_params' => (
- reader => 'rebless_params',
- default => sub { {} }
-));
-
-my %ANON_CLASSES;
-
-sub apply {
- my ( $self, $role, $meta ) = @_;
-
- my $anon_role_key = (blessed($meta) . $role->name);
-
- my $class;
- if (exists $ANON_CLASSES{$anon_role_key} && defined $ANON_CLASSES{$anon_role_key}) {
- $class = $ANON_CLASSES{$anon_role_key};
- }
- else {
- my $metaclass_class
- = ( ref $meta )->can('create_anon_class')
- ? ref $meta
- : 'Moose::Meta::Class';
- $class = $metaclass_class->create_anon_class(
- superclasses => [ blessed($meta) ],
- );
-
- $ANON_CLASSES{$anon_role_key} = $class;
- $self->SUPER::apply( $role, $class );
- }
-
- $class->rebless_instance( $meta, %{ $self->rebless_params } );
-}
-
-1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-Moose::Meta::Role::Application::ToMetaclassInstance - Compose a role into a metaclass instance
-
-=head1 DESCRIPTION
-
-=head2 METHODS
-
-=over 4
-
-=item B<new>
-
-=item B<meta>
-
-=item B<apply>
-
-=item B<rebless_params>
-
-=back
-
-=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
-
-Stevan Little E<lt>stevan@iinteractive.comE<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright 2006-2008 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
-
}
else {
$meta = $metaclass->initialize($role);
- $meta->alias_method('meta' => sub { $meta });
+
+ $meta->add_method(
+ 'meta' => sub {
+ # re-initialize so it inherits properly
+ $metaclass->initialize( ref($_[0]) || $_[0] );
+ }
+ );
}
return $meta;
sub apply_all_roles {
my $applicant = shift;
- 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;
+ confess "Must specify at least one role to apply to $applicant" unless @_;
- my $roles = Data::OptList::mkopt($role_list);
+ my $roles = Data::OptList::mkopt( [@_] );
my $meta = ( blessed $applicant ? $applicant : find_meta($applicant) );
if ( scalar @$roles == 1 ) {
my ( $role, $params ) = @{ $roles->[0] };
- $role->meta->$apply_method( $meta,
- ( defined $params ? %$params : () ) );
+ $role->meta->apply( $meta, ( defined $params ? %$params : () ) );
}
else {
- Moose::Meta::Role->combine( @$roles )->$apply_method($meta);
+ Moose::Meta::Role->combine( @$roles )->apply($meta);
}
}
C<@roles> will be pre-processed through L<Data::OptList::mkopt>
to allow for the additional arguments to be passed.
-=item B<apply_all_roles_with_method ($applicant, $method, @roles)>
-
-This function works just like C<apply_all_roles()>, except it allows
-you to specify what method will be called on the role metaclass when
-applying it to the C<$applicant>. This exists primarily so one can use
-the C<< Moose::Meta::Role->apply_to_metaclass_instance() >> method.
-
=item B<get_all_attribute_values($meta, $instance)>
Returns the values of the C<$instance>'s fields keyed by the attribute names.
Class::MOP::remove_metaclass_by_name($for);
+ # This could get called for a Moose::Meta::Role as well as a Moose::Meta::Class
my %classes = map {
$_ => _make_new_class( $old_meta->$_(), $options->{ $_ . '_roles' } )
- } qw(
+ }
+ grep { $old_meta->can($_) }
+ qw(
attribute_metaclass
method_metaclass
instance_metaclass
projects / gitmo/Moose.git / commitdiff