initialize a metaclass when trying to apply all roles

[gitmo/Moose.git] / lib / Moose / Util / MetaRole.pm

diff --git a/lib/Moose/Util/MetaRole.pm b/lib/Moose/Util/MetaRole.pm
index 30843d0..b68294f 100644 (file)
--- a/lib/Moose/Util/MetaRole.pm
+++ b/lib/Moose/Util/MetaRole.pm
@@ -4,33 +4,16 @@ use strict;
 use warnings;
 use Scalar::Util 'blessed';
 
-our $VERSION   = '1.16';
-$VERSION = eval $VERSION;
-our $AUTHORITY = 'cpan:STEVAN';
-
+use Carp qw( croak );
 use List::MoreUtils qw( all );
 use List::Util qw( first );
 use Moose::Deprecated;
-
-sub apply_metaclass_roles {
-    Moose::Deprecated::deprecated(
-        feature => 'pre-0.94 MetaRole API',
-        message =>
-            'The old Moose::Util::MetaRole API (before version 0.94) has been deprecated'
-    );
-
-    goto &apply_metaroles;
-}
+use Scalar::Util qw( blessed );
 
 sub apply_metaroles {
     my %args = @_;
 
-    _fixup_old_style_args(\%args);
-
-    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' );
@@ -40,62 +23,44 @@ sub apply_metaroles {
     }
 }
 
-sub _fixup_old_style_args {
-    my $args = shift;
+sub _metathing_for {
+    my $passed = shift;
 
-    return if $args->{class_metaroles} || $args->{role_metaroles};
+    my $found
+        = blessed $passed
+        ? $passed
+        : Class::MOP::class_of($passed);
 
-    Moose::Deprecated::deprecated(
-        feature => 'pre-0.94 MetaRole API',
-        message =>
-            'The old Moose::Util::MetaRole API (before version 0.94) has been deprecated'
-    );
-
-    $args->{for} = delete $args->{for_class}
-        if exists $args->{for_class};
-
-    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
-
-        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 {
@@ -133,12 +98,12 @@ 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() ],
     );
@@ -169,11 +134,9 @@ sub _make_new_class {
 
 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
 
@@ -316,17 +279,4 @@ This function will apply the specified roles to the object's base class.
 
 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