X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FRole.pm;h=fb17925cbe3998656618593970784f285098f17d;hb=2140a2269275f57dec2b84771b50197950c64f60;hp=e885b2fc0f336fdd8b887097b778019644890587;hpb=d47834546dd2f1e05250ee0fb18fe24bf9e0c1a2;p=gitmo%2FMoose.git diff --git a/lib/Moose/Role.pm b/lib/Moose/Role.pm index e885b2f..fb17925 100644 --- a/lib/Moose/Role.pm +++ b/lib/Moose/Role.pm @@ -7,10 +7,6 @@ use Carp 'croak'; use Sub::Exporter; -our $VERSION = '0.89'; -$VERSION = eval $VERSION; -our $AUTHORITY = 'cpan:STEVAN'; - use Moose (); use Moose::Util (); @@ -23,23 +19,23 @@ sub extends { } sub with { - Moose::Util::apply_all_roles( Moose::Meta::Role->initialize(shift), @_ ); + Moose::Util::apply_all_roles( shift, @_ ); } sub requires { - my $meta = Moose::Meta::Role->initialize(shift); + my $meta = shift; croak "Must specify at least one method" unless @_; $meta->add_required_methods(@_); } sub excludes { - my $meta = Moose::Meta::Role->initialize(shift); + my $meta = shift; croak "Must specify at least one role" unless @_; $meta->add_excluded_roles(@_); } sub has { - my $meta = Moose::Meta::Role->initialize(shift); + my $meta = shift; my $name = shift; croak 'Usage: has \'name\' => ( key => value, ... )' if @_ == 1; my %options = ( definition_context => Moose::Util::_caller_info(), @_ ); @@ -49,17 +45,14 @@ sub has { 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 ); + my $meta = shift; + + if ( ref($_[0]) eq 'Regexp' ) { + croak "Roles do not currently support regex " + . " references for $type method modifiers"; } + + Moose::Util::add_method_modifier($meta, $type, \@_); } sub before { _add_method_modifier('before', @_) } @@ -75,7 +68,7 @@ sub super { } sub override { - my $meta = Moose::Meta::Role->initialize(shift); + my $meta = shift; my ( $name, $code ) = @_; $meta->add_override_method_modifier( $name, $code ); } @@ -89,7 +82,7 @@ sub augment { } Moose::Exporter->setup_import_methods( - with_caller => [ + with_meta => [ qw( with requires excludes has before after around override ) ], as_is => [ @@ -111,29 +104,42 @@ sub init_meta { } my $metaclass = $args{metaclass} || "Moose::Meta::Role"; + my $meta_name = exists $args{meta_name} ? $args{meta_name} : 'meta'; - # make a subtype for each Moose class + Moose->throw_error("The Metaclass $metaclass must be a subclass of Moose::Meta::Role.") + unless $metaclass->isa('Moose::Meta::Role'); + + # make a subtype for each Moose role role_type $role unless find_type_constraint($role); - # FIXME copy from Moose.pm my $meta; - if ($role->can('meta')) { - $meta = $role->meta(); - - 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"); + if ( $meta = Class::MOP::get_metaclass_by_name($role) ) { + unless ( $meta->isa("Moose::Meta::Role") ) { + my $error_message = "$role already has a metaclass, but it does not inherit $metaclass ($meta)."; + if ( $meta->isa('Moose::Meta::Class') ) { + Moose->throw_error($error_message . ' You cannot make the same thing a role and a class. Remove either Moose or Moose::Role.'); + } else { + Moose->throw_error($error_message); + } } } else { $meta = $metaclass->initialize($role); + } - $meta->add_method( - 'meta' => sub { - # re-initialize so it inherits properly - $metaclass->initialize( ref($_[0]) || $_[0] ); - } - ); + if (defined $meta_name) { + # also check for inherited non moose 'meta' method? + my $existing = $meta->get_method($meta_name); + if ($existing && !$existing->isa('Class::MOP::Method::Meta')) { + Carp::cluck "Moose::Role is overwriting an existing method named " + . "$meta_name in role $role with a method " + . "which returns the class's metaclass. If this is " + . "actually what you want, you should remove the " + . "existing method, otherwise, you should rename or " + . "disable this generated method using the " + . "'-meta_name' option to 'use Moose::Role'."; + } + $meta->_add_meta_method($meta_name); } return $meta; @@ -141,14 +147,12 @@ sub init_meta { 1; +# ABSTRACT: The Moose Role + __END__ =pod -=head1 NAME - -Moose::Role - The Moose Role - =head1 SYNOPSIS package Eq; @@ -181,7 +185,7 @@ serves as API documentation. =head1 EXPORTED FUNCTIONS Moose::Role currently supports all of the functions that L exports, but -differs slightly in how some items are handled (see L below for +differs slightly in how some items are handled (see L below for details). Moose::Role also offers two role-specific keyword exports: @@ -234,6 +238,23 @@ this, your class's C object will have the specified traits applied to it. See L for more details. +=head1 APPLYING ROLES + +In addition to being applied to a class using the 'with' syntax (see +L) and using the L 'apply_all_roles' +method, roles may also be applied to an instance of a class using +L 'apply_all_roles' or the role's metaclass: + + MyApp::Test::SomeRole->meta->apply( $instance ); + +Doing this creates a new, mutable, anonymous subclass, applies the role to that, +and reblesses. In a debugger, for example, you will see class names of the +form C< Class::MOP::Class::__ANON__::SERIAL::6 >, which means that doing a 'ref' +on your instance may not return what you expect. See L for 'DOES'. + +Additional params may be added to the new instance by providing 'rebless_params'. +See L. + =head1 CAVEATS Role support has only a few caveats: @@ -264,23 +285,6 @@ ordering. =head1 BUGS -All complex software has bugs lurking in it, and this module is no -exception. If you find a bug please either email me, or add the bug -to cpan-RT. - -=head1 AUTHOR - -Stevan Little Estevan@iinteractive.comE - -Christian Hansen Echansen@cpan.orgE - -=head1 COPYRIGHT AND LICENSE - -Copyright 2006-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. +See L for details on reporting bugs. =cut