clean up type constraint declaration syntax in the docs a bit
[gitmo/Moose.git] / lib / Moose / Util / MetaRole.pm
index 6b06d0f..150382e 100644 (file)
@@ -4,14 +4,20 @@ use strict;
 use warnings;
 use Scalar::Util 'blessed';
 
-our $VERSION   = '1.08';
-$VERSION = eval $VERSION;
-our $AUTHORITY = 'cpan:STEVAN';
-
+use Carp qw( croak );
 use List::MoreUtils qw( all );
 use List::Util qw( first );
+use Moose::Deprecated;
+use Scalar::Util qw( blessed );
 
 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.'
+            . ' Using this API will throw an error in Moose 2.0200.'
+    );
+
     goto &apply_metaroles;
 }
 
@@ -19,11 +25,8 @@ 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' );
@@ -33,10 +36,57 @@ sub apply_metaroles {
     }
 }
 
+sub _metathing_for {
+    my $passed = shift;
+
+    my $found
+        = blessed $passed
+        ? $passed
+        : Class::MOP::class_of($passed);
+
+    return $found
+        if defined $found
+            && blessed $found
+            && (   $found->isa('Moose::Meta::Role')
+                || $found->isa('Moose::Meta::Class') );
+
+    local $Carp::CarpLevel = $Carp::CarpLevel + 1;
+
+    my $error_start
+        = 'When using Moose::Util::MetaRole, you must pass a Moose class name,'
+        . ' role name, metaclass object, or metarole object.';
+
+    if ( defined $found && blessed $found ) {
+        croak $error_start
+            . " You passed $passed, and we resolved this to a "
+            . ( blessed $found )
+            . ' object.';
+    }
+
+    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?';
+    }
+
+    if ( !defined $passed ) {
+        croak $error_start
+            . " You passed an undef."
+            . ' Maybe you need to call Moose->init_meta to initialize the metaclass first?';
+    }
+}
+
 sub _fixup_old_style_args {
     my $args = shift;
 
-    return if $args->{class_metaroles} || $args->{roles_metaroles};
+    return if $args->{class_metaroles} || $args->{role_metaroles};
+
+    Moose::Deprecated::deprecated(
+        feature => 'pre-0.94 MetaRole API',
+        message =>
+            'The old Moose::Util::MetaRole API (before version 0.94) has been deprecated.'
+            . ' Using this API will throw an error in Moose 2.0200.'
+    );
 
     $args->{for} = delete $args->{for_class}
         if exists $args->{for_class};
@@ -120,12 +170,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() ],
     );
@@ -156,11 +206,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
 
@@ -211,16 +259,9 @@ extensions can apply roles in any order.
 
 =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
 
@@ -310,17 +351,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