X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FRole.pm;h=97d2d6457e660d8593b4c957b7ae1ddcee16b06a;hp=4c53da3334f97351e6ab912e0df857226840c038;hb=f7e41edaceee0d549a2d664378cfcf85dcf9454b;hpb=034587d897c53d4df84085a9229334bd2d51f1c6 diff --git a/lib/Mouse/Meta/Role.pm b/lib/Mouse/Meta/Role.pm index 4c53da3..97d2d64 100644 --- a/lib/Mouse/Meta/Role.pm +++ b/lib/Mouse/Meta/Role.pm @@ -4,17 +4,17 @@ use Mouse::Util qw(:meta not_supported english_list); # enables strict and warni use Mouse::Meta::Module; our @ISA = qw(Mouse::Meta::Module); -sub method_metaclass(){ 'Mouse::Meta::Role::Method' } # required for get_method() +sub method_metaclass; sub _construct_meta { my $class = shift; my %args = @_; - $args{methods} ||= {}; - $args{attributes} ||= {}; - $args{required_methods} ||= []; - $args{roles} ||= []; + $args{methods} = {}; + $args{attributes} = {}; + $args{required_methods} = []; + $args{roles} = []; my $self = bless \%args, ref($class) || $class; if($class ne __PACKAGE__){ @@ -29,11 +29,9 @@ sub create_anon_role{ return $self->create(undef, @_); } -sub is_anon_role{ - return exists $_[0]->{anon_serial_id}; -} +sub is_anon_role; -sub get_roles { $_[0]->{roles} } +sub get_roles; sub calculate_all_roles { my $self = shift; @@ -188,10 +186,10 @@ sub apply { my $instance; - if($applicant->isa('Mouse::Meta::Class')){ # Application::ToClass + if(Mouse::Util::is_a_metaclass($applicant)){ # Application::ToClass $args{_to} = 'class'; } - elsif($applicant->isa('Mouse::Meta::Role')){ # Application::ToRole + elsif(Mouse::Util::is_a_metarole($applicant)){ # Application::ToRole $args{_to} = 'role'; } else{ # Appplication::ToInstance @@ -257,27 +255,36 @@ sub combine { return $composite; } -for my $modifier_type (qw/before after around/) { - - my $modifier = "${modifier_type}_method_modifiers"; +sub add_before_method_modifier { + my ($self, $method_name, $method) = @_; - my $add_method_modifier = sub { - my ($self, $method_name, $method) = @_; - - push @{ $self->{$modifier}->{$method_name} ||= [] }, $method; - return; - }; + push @{ $self->{before_method_modifiers}{$method_name} ||= [] }, $method; + return; +} +sub add_around_method_modifier { + my ($self, $method_name, $method) = @_; - my $get_method_modifiers = sub { - my ($self, $method_name) = @_; - return @{ $self->{$modifier}->{$method_name} ||= [] } - }; + push @{ $self->{around_method_modifiers}{$method_name} ||= [] }, $method; + return; +} +sub add_after_method_modifier { + my ($self, $method_name, $method) = @_; - no strict 'refs'; - *{ 'add_' . $modifier_type . '_method_modifier' } = $add_method_modifier; - *{ 'get_' . $modifier_type . '_method_modifiers' } = $get_method_modifiers; + push @{ $self->{after_method_modifiers}{$method_name} ||= [] }, $method; + return; +} - # has_${modifier_type}_method_modifiers is moved into t::lib::Test::Mouse +sub get_before_method_modifiers { + my ($self, $method_name) = @_; + return @{ $self->{before_method_modifiers}{$method_name} ||= [] } +} +sub get_around_method_modifiers { + my ($self, $method_name) = @_; + return @{ $self->{around_method_modifiers}{$method_name} ||= [] } +} +sub get_after_method_modifiers { + my ($self, $method_name) = @_; + return @{ $self->{after_method_modifiers}{$method_name} ||= [] } } sub add_override_method_modifier{ @@ -323,7 +330,7 @@ Mouse::Meta::Role - The Mouse Role metaclass =head1 VERSION -This document describes Mouse version 0.40 +This document describes Mouse version 0.40_08 =head1 SEE ALSO