X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FRole.pm;h=5b3a8d04e3aa9dc7edc6dbb1aecef82695f4c9f6;hb=a3319906531cef2b41a87138e75461ced7a3394b;hp=7a2994815491cbfc237568e91c6c44206b7a7015;hpb=5bd4db9b7e1ab30af23aa908be646f5b52010fdf;p=gitmo%2FMoose.git diff --git a/lib/Moose/Role.pm b/lib/Moose/Role.pm index 7a29948..5b3a8d0 100644 --- a/lib/Moose/Role.pm +++ b/lib/Moose/Role.pm @@ -5,68 +5,44 @@ 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.73_01'; +$VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; use Moose (); use Moose::Util (); +use Moose::Exporter; use Moose::Meta::Role; use Moose::Util::TypeConstraints; -{ - my %METAS; - - sub init_meta { - my $role = shift; - - return $METAS{$role} if exists $METAS{$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; - } -} - sub extends { croak "Roles do not currently support '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 = @_; @@ -75,11 +51,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 $_; @@ -88,11 +64,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 $_; @@ -101,10 +77,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 $_; @@ -119,20 +95,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_exporter( +Moose::Exporter->setup_import_methods( with_caller => [ qw( with requires excludes has before after around override make_immutable ) ], @@ -143,35 +119,44 @@ my $exporter = Moose::Exporter->build_exporter( ], ); -sub import { - my $caller = Moose::Exporter->get_caller(@_); - - # this works because both pragmas set $^H (see perldoc perlvar) - # which affects the current compilation - i.e. the file who use'd - # us - which is why we don't need to do anything special to make - # it affect that file rather than this one (which is already compiled) +sub init_meta { + shift; + my %args = @_; - strict->import; - warnings->import; + my $role = $args{for_class}; - # we should never export to main - if ($caller eq 'main') { - warn qq{Moose::Role does not export its sugar to the 'main' package.\n}; - return; + unless ($role) { + require Moose; + Moose->throw_error("Cannot call init_meta without specifying a for_class"); } - init_meta($caller); + my $metaclass = $args{metaclass} || "Moose::Meta::Role"; - goto $exporter; -} + # make a subtype for each Moose class + role_type $role unless find_type_constraint($role); -sub unimport { - my $caller = Moose::Exporter->get_caller(@_); + # FIXME copy from Moose.pm + my $meta; + if ($role->can('meta')) { + $meta = $role->meta(); - Moose::Exporter->remove_keywords( - source => __PACKAGE__, - from => $caller, - ); + unless ( blessed($meta) && $meta->isa('Moose::Meta::Role') ) { + require Moose; + 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; @@ -247,6 +232,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: @@ -273,16 +267,6 @@ In most cases, this will be a non-issue; however, it is something to keep in mind when using method modifiers in a role. You should never assume any ordering. -=item * - -The C keyword currently only works with actual methods. A method -modifier (before/around/after and override) will not count as a fufillment -of the requirement, and neither will an autogenerated accessor for an attribute. - -It is likely that attribute accessors will eventually be allowed to fufill those -requirements, or we will introduce a C keyword of some kind -instead. This decision has not yet been finalized. - =back =head1 BUGS @@ -299,7 +283,7 @@ Christian Hansen Echansen@cpan.orgE =head1 COPYRIGHT AND LICENSE -Copyright 2006-2008 by Infinity Interactive, Inc. +Copyright 2006-2009 by Infinity Interactive, Inc. L