X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FRole.pm;h=61aff6721aa388b4a4f35ae9e0e8747330fb298d;hb=df8260e9a27a9d7532a21525223975fcf8e26562;hp=4c6ae21a73e8d7e8caa44883db8f3576f45e4b41;hpb=a5c426fc6d2e353f115051322044234efeca3b66;p=gitmo%2FMoose.git diff --git a/lib/Moose/Role.pm b/lib/Moose/Role.pm index 4c6ae21..61aff67 100644 --- a/lib/Moose/Role.pm +++ b/lib/Moose/Role.pm @@ -5,12 +5,13 @@ use strict; use warnings; use Scalar::Util 'blessed'; -use Carp 'confess', 'croak'; +use Carp 'croak'; use Data::OptList; use Sub::Exporter; -our $VERSION = '0.56'; +our $VERSION = '0.63'; +$VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; use Moose (); @@ -24,23 +25,23 @@ sub extends { } sub with { - Moose::Util::apply_all_roles( shift->meta(), @_ ); + Moose::Util::apply_all_roles( Moose::Meta::Role->initialize(shift), @_ ); } sub requires { - my $meta = shift->meta(); + my $meta = Moose::Meta::Role->initialize(shift); croak "Must specify at least one method" unless @_; $meta->add_required_methods(@_); } sub excludes { - my $meta = shift->meta(); + my $meta = Moose::Meta::Role->initialize(shift); croak "Must specify at least one role" unless @_; $meta->add_excluded_roles(@_); } sub has { - my $meta = shift->meta(); + my $meta = Moose::Meta::Role->initialize(shift); my $name = shift; croak 'Usage: has \'name\' => ( key => value, ... )' if @_ == 1; my %options = @_; @@ -49,11 +50,11 @@ sub has { } sub before { - my $meta = shift->meta(); + my $meta = Moose::Meta::Role->initialize(shift); my $code = pop @_; for (@_) { - croak "Moose::Role do not currently support " + croak "Roles do not currently support " . ref($_) . " references for before method modifiers" if ref $_; @@ -62,11 +63,11 @@ sub before { } sub after { - my $meta = shift->meta(); + my $meta = Moose::Meta::Role->initialize(shift); my $code = pop @_; for (@_) { - croak "Moose::Role do not currently support " + croak "Roles do not currently support " . ref($_) . " references for after method modifiers" if ref $_; @@ -75,10 +76,10 @@ sub after { } sub around { - my $meta = shift->meta(); + my $meta = Moose::Meta::Role->initialize(shift); my $code = pop @_; for (@_) { - croak "Moose::Role do not currently support " + croak "Roles do not currently support " . ref($_) . " references for around method modifiers" if ref $_; @@ -93,20 +94,20 @@ sub super { } sub override { - my $meta = shift->meta(); + my $meta = Moose::Meta::Role->initialize(shift); my ( $name, $code ) = @_; $meta->add_override_method_modifier( $name, $code ); } sub inner { - croak "Moose::Role cannot support 'inner'"; + croak "Roles cannot support 'inner'"; } sub augment { - croak "Moose::Role cannot support 'augment'"; + croak "Roles cannot support 'augment'"; } -my $exporter = Moose::Exporter->build_import_methods( +my $exporter = Moose::Exporter->setup_import_methods( with_caller => [ qw( with requires excludes has before after around override make_immutable ) ], @@ -115,33 +116,39 @@ my $exporter = Moose::Exporter->build_import_methods( \&Carp::confess, \&Scalar::Util::blessed, ], - also => sub { init_meta(shift) }, ); -{ - my %METAS; +sub init_meta { + shift; + my %args = @_; - sub init_meta { - my $role = shift; + my $role = $args{for_class} + or Moose->throw_error("Cannot call init_meta without specifying a for_class"); - return $METAS{$role} if exists $METAS{$role}; + my $metaclass = $args{metaclass} || "Moose::Meta::Role"; - # make a subtype for each Moose class - role_type $role unless find_type_constraint($role); + # make a subtype for each Moose class + role_type $role unless find_type_constraint($role); - my $meta; - if ($role->can('meta')) { - $meta = $role->meta(); - (blessed($meta) && $meta->isa('Moose::Meta::Role')) - || confess "You already have a &meta function, but it does not return a Moose::Meta::Role"; - } - else { - $meta = Moose::Meta::Role->initialize($role); - $meta->alias_method('meta' => sub { $meta }); - } - - return $METAS{$role} = $meta; + # FIXME copy from Moose.pm + my $meta; + if ($role->can('meta')) { + $meta = $role->meta(); + (blessed($meta) && $meta->isa('Moose::Meta::Role')) + || Moose->throw_error("You already have a &meta function, but it does not return a Moose::Meta::Role"); + } + else { + $meta = $metaclass->initialize($role); + + $meta->add_method( + 'meta' => sub { + # re-initialize so it inherits properly + $metaclass->initialize( ref($_[0]) || $_[0] ); + } + ); } + + return $meta; } 1; @@ -217,6 +224,15 @@ Moose::Role offers a way to remove the keywords it exports, through the C method. You simply have to say C at the bottom of your code for this to work. +=head2 B<< Moose::Role->init_meta(for_class => $role, metaclass => $metaclass) >> + +The C method sets up the metaclass object for the role +specified by C. It also injects a a C accessor into +the role so you can get at this object. + +The default metaclass is L. You can specify an +alternate metaclass with the C parameter. + =head1 CAVEATS Role support has only a few caveats: