X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FUtil%2FMetaRole.pm;h=150382eb4f48f215e7a2c33e0935d317c7b3b469;hb=04eec38788d1bd5d30c86c7907d2fae596c0a1fc;hp=6b06d0f98e489bf13221f062da536cc3466ef053;hpb=72643035d73124e0b4ef7a8335cdc4f793732b5a;p=gitmo%2FMoose.git diff --git a/lib/Moose/Util/MetaRole.pm b/lib/Moose/Util/MetaRole.pm index 6b06d0f..150382e 100644 --- a/lib/Moose/Util/MetaRole.pm +++ b/lib/Moose/Util/MetaRole.pm @@ -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. 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, which can generate the appropriate C -method for you, and make sure it is called when imported. +The easiest way to use this module is through L, which can +generate the appropriate C 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 for details on reporting bugs. -=head1 AUTHOR - -Dave Rolsky Eautarch@urth.orgE - -=head1 COPYRIGHT AND LICENSE - -Copyright 2009 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