use warnings;
use Scalar::Util 'blessed';
-our $VERSION = '1.00';
-$VERSION = eval $VERSION;
-our $AUTHORITY = 'cpan:STEVAN';
-
+use Carp qw( croak );
use List::MoreUtils qw( all );
use List::Util qw( first );
-
-sub apply_metaclass_roles {
- goto &apply_metaroles;
-}
+use Moose::Deprecated;
+use Scalar::Util qw( blessed );
sub apply_metaroles {
my %args = @_;
- _fixup_old_style_args(\%args);
- Carp::cluck('applying') if $::D;
- my $for
- = blessed $args{for}
- ? $args{for}
- : Class::MOP::class_of( $args{for} );
+ my $for = _metathing_for( $args{for} );
if ( $for->isa('Moose::Meta::Role') ) {
return _make_new_metaclass( $for, $args{role_metaroles}, 'role' );
}
}
-sub _fixup_old_style_args {
- my $args = shift;
-
- return if $args->{class_metaroles} || $args->{roles_metaroles};
-
- $args->{for} = delete $args->{for_class}
- if exists $args->{for_class};
+sub _metathing_for {
+ my $passed = shift;
- my @old_keys = qw(
- attribute_metaclass_roles
- method_metaclass_roles
- wrapped_method_metaclass_roles
- instance_metaclass_roles
- constructor_class_roles
- destructor_class_roles
- error_class_roles
+ my $found
+ = blessed $passed
+ ? $passed
+ : Class::MOP::class_of($passed);
- application_to_class_class_roles
- application_to_role_class_roles
- application_to_instance_class_roles
- application_role_summation_class_roles
- );
+ return $found
+ if defined $found
+ && blessed $found
+ && ( $found->isa('Moose::Meta::Role')
+ || $found->isa('Moose::Meta::Class') );
- my $for
- = blessed $args->{for}
- ? $args->{for}
- : Class::MOP::class_of( $args->{for} );
+ local $Carp::CarpLevel = $Carp::CarpLevel + 1;
- my $top_key;
- if ( $for->isa('Moose::Meta::Class') ) {
- $top_key = 'class_metaroles';
+ my $error_start
+ = 'When using Moose::Util::MetaRole, you must pass a Moose class name,'
+ . ' role name, metaclass object, or metarole object.';
- $args->{class_metaroles}{class} = delete $args->{metaclass_roles}
- if exists $args->{metaclass_roles};
+ if ( defined $found && blessed $found ) {
+ croak $error_start
+ . " You passed $passed, and we resolved this to a "
+ . ( blessed $found )
+ . ' object.';
}
- else {
- $top_key = 'role_metaroles';
- $args->{role_metaroles}{role} = delete $args->{metaclass_roles}
- if exists $args->{metaclass_roles};
+ if ( defined $passed && !defined $found ) {
+ croak $error_start
+ . " You passed $passed, and this did not resolve to a metaclass or metarole."
+ . ' Maybe you need to call Moose->init_meta to initialize the metaclass first?';
}
- for my $old_key (@old_keys) {
- my ($new_key) = $old_key =~ /^(.+)_(?:class|metaclass)_roles$/;
-
- $args->{$top_key}{$new_key} = delete $args->{$old_key}
- if exists $args->{$old_key};
+ if ( !defined $passed ) {
+ croak $error_start
+ . " You passed an undef."
+ . ' Maybe you need to call Moose->init_meta to initialize the metaclass first?';
}
-
- return;
}
sub _make_new_metaclass {
sub apply_base_class_roles {
my %args = @_;
- my $for = $args{for} || $args{for_class};
-
- my $meta = Class::MOP::class_of($for);
+ my $meta = _metathing_for( $args{for} || $args{for_class} );
+ croak 'You can only apply base class roles to a Moose class, not a role.'
+ if $meta->isa('Moose::Meta::Role');
my $new_base = _make_new_class(
- $for,
+ $meta->name,
$args{roles},
[ $meta->superclasses() ],
);
1;
-__END__
-
-=head1 NAME
+# ABSTRACT: Apply roles to any metaclass, as well as the object base class
-Moose::Util::MetaRole - Apply roles to any metaclass, as well as the object base class
+__END__
=head1 SYNOPSIS
=head1 USAGE
-B<It is very important that you only call this module's functions when
-your module is imported by the caller>. The process of applying roles
-to the metaclass reinitializes the metaclass object, which wipes out
-any existing attributes already defined. However, as long as you do
-this when your module is imported, the caller should not have any
-attributes defined yet.
-
-The easiest way to ensure that this happens is to use
-L<Moose::Exporter>, which can generate the appropriate C<init_meta>
-method for you, and make sure it is called when imported.
+The easiest way to use this module is through L<Moose::Exporter>, which can
+generate the appropriate C<init_meta> method for you, and make sure it is
+called when imported.
=head1 FUNCTIONS
See L<Moose/BUGS> for details on reporting bugs.
-=head1 AUTHOR
-
-Dave Rolsky E<lt>autarch@urth.orgE<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright 2009 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