From: Dave Rolsky Date: Tue, 26 Aug 2008 16:21:41 +0000 (+0000) Subject: Re-implemented metaclass traits using Moose::Util::MetaRole. This X-Git-Tag: 0.55_04~2^2~26 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=72d15b838f9f72a7fe7dcc1570c4b445d9252c2b;p=gitmo%2FMoose.git Re-implemented metaclass traits using Moose::Util::MetaRole. This means removing some new bits I added in Moose::Util and the Moose::Meta::Role::Application::ToMetaclassInstance class. --- diff --git a/lib/Moose/Exporter.pm b/lib/Moose/Exporter.pm index 9d4d64c..fe3bc4a 100644 --- a/lib/Moose/Exporter.pm +++ b/lib/Moose/Exporter.pm @@ -6,6 +6,7 @@ use warnings; use Carp qw( confess ); use Class::MOP; use List::MoreUtils qw( first_index uniq ); +use Moose::Util::MetaRole; use Sub::Exporter; @@ -215,10 +216,10 @@ sub _make_sub_exporter_params { $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"; } @@ -231,7 +232,7 @@ sub _make_sub_exporter_params { 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 ]; @@ -245,8 +246,7 @@ sub _strip_traits { sub _apply_meta_traits { my ( $class, $traits ) = @_; - return - unless $traits && @$traits; + return unless @{$traits}; my $meta = $class->meta(); @@ -255,21 +255,16 @@ sub _apply_meta_traits { '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 { diff --git a/lib/Moose/Meta/Role/Application/ToMetaclassInstance.pm b/lib/Moose/Meta/Role/Application/ToMetaclassInstance.pm deleted file mode 100644 index d8bfe39..0000000 --- a/lib/Moose/Meta/Role/Application/ToMetaclassInstance.pm +++ /dev/null @@ -1,93 +0,0 @@ -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 - -=item B - -=item B - -=item B - -=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 Estevan@iinteractive.comE - -=head1 COPYRIGHT AND LICENSE - -Copyright 2006-2008 by Infinity Interactive, Inc. - -L - -This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. - -=cut - diff --git a/lib/Moose/Role.pm b/lib/Moose/Role.pm index 318fade..47ff324 100644 --- a/lib/Moose/Role.pm +++ b/lib/Moose/Role.pm @@ -140,7 +140,13 @@ sub init_meta { } 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; diff --git a/lib/Moose/Util.pm b/lib/Moose/Util.pm index b5bed65..91e8745 100644 --- a/lib/Moose/Util.pm +++ b/lib/Moose/Util.pm @@ -73,16 +73,9 @@ sub search_class_by_role { 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) ); @@ -98,11 +91,10 @@ sub apply_all_roles_with_method { 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); } } @@ -229,13 +221,6 @@ actually used internally by both L and L, and the C<@roles> will be pre-processed through L to allow for the additional arguments to be passed. -=item B - -This function works just like C, 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 Returns the values of the C<$instance>'s fields keyed by the attribute names. diff --git a/lib/Moose/Util/MetaRole.pm b/lib/Moose/Util/MetaRole.pm index 2ddff9b..5c61939 100644 --- a/lib/Moose/Util/MetaRole.pm +++ b/lib/Moose/Util/MetaRole.pm @@ -46,9 +46,12 @@ sub _make_new_metaclass { 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