X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FRole.pm;h=5910c9801d9aa92943181256e1c89ea0243f2d73;hb=2ee514b1f22357435ed4271f8a9f9d1dd175e508;hp=de4b6983cc28a15cc6d5eba912cdc7a08c1b050e;hpb=a94188ac85b86f501de86f25496e821e31d74cac;p=gitmo%2FMoose.git diff --git a/lib/Moose/Role.pm b/lib/Moose/Role.pm index de4b698..5910c98 100644 --- a/lib/Moose/Role.pm +++ b/lib/Moose/Role.pm @@ -1,207 +1,141 @@ package Moose::Role; -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.79'; +$VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; use Moose (); use Moose::Util (); +use Moose::Exporter; use Moose::Meta::Role; use Moose::Util::TypeConstraints; -{ - my ( $CALLER, %METAS ); +sub extends { + croak "Roles do not currently support 'extends'"; +} - sub _find_meta { - my $role = $CALLER; +sub with { + Moose::Util::apply_all_roles( Moose::Meta::Role->initialize(shift), @_ ); +} - return $METAS{$role} if exists $METAS{$role}; +sub requires { + my $meta = Moose::Meta::Role->initialize(shift); + croak "Must specify at least one method" unless @_; + $meta->add_required_methods(@_); +} - # make a subtype for each Moose class - role_type $role unless find_type_constraint($role); +sub excludes { + my $meta = Moose::Meta::Role->initialize(shift); + croak "Must specify at least one role" unless @_; + $meta->add_excluded_roles(@_); +} - 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 }); - } +sub has { + my $meta = Moose::Meta::Role->initialize(shift); + my $name = shift; + croak 'Usage: has \'name\' => ( key => value, ... )' if @_ == 1; + my %options = @_; + my $attrs = ( ref($name) eq 'ARRAY' ) ? $name : [ ($name) ]; + $meta->add_attribute( $_, %options ) for @$attrs; +} - return $METAS{$role} = $meta; +sub _add_method_modifier { + my $type = shift; + my $meta = Moose::Meta::Role->initialize(shift); + my $code = pop @_; + + for (@_) { + croak "Roles do not currently support " + . ref($_) + . " references for $type method modifiers" + if ref $_; + my $add_method = "add_${type}_method_modifier"; + $meta->$add_method( $_, $code ); } +} +sub before { _add_method_modifier('before', @_) } - my %exports = ( - extends => sub { - my $meta = _find_meta(); - return Class::MOP::subname('Moose::Role::extends' => sub { - croak "Roles do not currently support 'extends'" - }); - }, - with => sub { - my $meta = _find_meta(); - return Class::MOP::subname('Moose::Role::with' => sub (@) { - Moose::Util::apply_all_roles($meta, @_) - }); - }, - requires => sub { - my $meta = _find_meta(); - return Class::MOP::subname('Moose::Role::requires' => sub (@) { - croak "Must specify at least one method" unless @_; - $meta->add_required_methods(@_); - }); - }, - excludes => sub { - my $meta = _find_meta(); - return Class::MOP::subname('Moose::Role::excludes' => sub (@) { - croak "Must specify at least one role" unless @_; - $meta->add_excluded_roles(@_); - }); - }, - has => sub { - my $meta = _find_meta(); - return Class::MOP::subname('Moose::Role::has' => sub ($;%) { - my $name = shift; - croak 'Usage: has \'name\' => ( key => value, ... )' if @_ == 1; - my %options = @_; - my $attrs = ( ref($name) eq 'ARRAY' ) ? $name : [ ($name) ]; - $meta->add_attribute( $_, %options ) for @$attrs; - }); - }, - before => sub { - my $meta = _find_meta(); - return Class::MOP::subname('Moose::Role::before' => sub (@&) { - my $code = pop @_; - do { - croak "Moose::Role do not currently support " - . ref($_) - . " references for before method modifiers" - if ref $_; - $meta->add_before_method_modifier($_, $code) - } for @_; - }); - }, - after => sub { - my $meta = _find_meta(); - return Class::MOP::subname('Moose::Role::after' => sub (@&) { - my $code = pop @_; - do { - croak "Moose::Role do not currently support " - . ref($_) - . " references for after method modifiers" - if ref $_; - $meta->add_after_method_modifier($_, $code) - } for @_; - }); - }, - around => sub { - my $meta = _find_meta(); - return Class::MOP::subname('Moose::Role::around' => sub (@&) { - my $code = pop @_; - do { - croak "Moose::Role do not currently support " - . ref($_) - . " references for around method modifiers" - if ref $_; - $meta->add_around_method_modifier($_, $code) - } for @_; - }); - }, - # see Moose.pm for discussion - super => sub { - return Class::MOP::subname('Moose::Role::super' => sub { - return unless $Moose::SUPER_BODY; $Moose::SUPER_BODY->(@Moose::SUPER_ARGS) - }); - }, - override => sub { - my $meta = _find_meta(); - return Class::MOP::subname('Moose::Role::override' => sub ($&) { - my ($name, $code) = @_; - $meta->add_override_method_modifier($name, $code); - }); - }, - inner => sub { - my $meta = _find_meta(); - return Class::MOP::subname('Moose::Role::inner' => sub { - croak "Moose::Role cannot support 'inner'"; - }); - }, - augment => sub { - my $meta = _find_meta(); - return Class::MOP::subname('Moose::Role::augment' => sub { - croak "Moose::Role cannot support 'augment'"; - }); - }, - confess => sub { - return \&Carp::confess; - }, - blessed => sub { - return \&Scalar::Util::blessed; - } - ); +sub after { _add_method_modifier('after', @_) } - my $exporter = Sub::Exporter::build_exporter({ - exports => \%exports, - groups => { - default => [':all'] - } - }); +sub around { _add_method_modifier('around', @_) } - sub import { - $CALLER = - ref $_[1] && defined $_[1]->{into} ? $_[1]->{into} - : ref $_[1] - && defined $_[1]->{into_level} ? caller( $_[1]->{into_level} ) - : caller(); +# see Moose.pm for discussion +sub super { + return unless $Moose::SUPER_BODY; + $Moose::SUPER_BODY->(@Moose::SUPER_ARGS); +} - # 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 override { + my $meta = Moose::Meta::Role->initialize(shift); + my ( $name, $code ) = @_; + $meta->add_override_method_modifier( $name, $code ); +} - strict->import; - warnings->import; +sub inner { + croak "Roles cannot support 'inner'"; +} - # we should never export to main - return if $CALLER eq 'main'; +sub augment { + croak "Roles cannot support 'augment'"; +} - goto $exporter; - }; +Moose::Exporter->setup_import_methods( + with_caller => [ + qw( with requires excludes has before after around override make_immutable ) + ], + as_is => [ + qw( extends super inner augment ), + \&Carp::confess, + \&Scalar::Util::blessed, + ], +); + +sub init_meta { + shift; + my %args = @_; + + my $role = $args{for_class}; + + unless ($role) { + require Moose; + Moose->throw_error("Cannot call init_meta without specifying a for_class"); + } - sub unimport { - no strict 'refs'; - my $class = Moose::_get_caller(@_); + my $metaclass = $args{metaclass} || "Moose::Meta::Role"; - # loop through the exports ... - foreach my $name ( keys %exports ) { + # make a subtype for each Moose class + role_type $role unless find_type_constraint($role); - # if we find one ... - if ( defined &{ $class . '::' . $name } ) { - my $keyword = \&{ $class . '::' . $name }; + # FIXME copy from Moose.pm + my $meta; + if ($role->can('meta')) { + $meta = $role->meta(); - # make sure it is from Moose::Role - my ($pkg_name) = Class::MOP::get_code_info($keyword); - next if $pkg_name ne 'Moose::Role'; + 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); - # and if it is from Moose::Role then undef the slot - delete ${ $class . '::' }{$name}; + $meta->add_method( + 'meta' => sub { + # re-initialize so it inherits properly + $metaclass->initialize( ref($_[0]) || $_[0] ); } - } + ); } + + return $meta; } 1; @@ -277,6 +211,29 @@ 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 METACLASS + +When you use Moose::Role, you can specify which metaclass to use: + + use Moose::Role -metaclass => 'My::Meta::Role'; + +You can also specify traits which will be applied to your role metaclass: + + use Moose::Role -traits => 'My::Trait'; + +This is very similar to the attribute traits feature. When you do +this, your class's C object will have the specified traits +applied to it. See L for more details. + =head1 CAVEATS Role support has only a few caveats: @@ -303,16 +260,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 @@ -329,7 +276,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