X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FMixin%2FHasMethods.pm;h=df91a13ce28efa5ad17e6bacbbf195c4c9854e78;hb=0f3528820cf19ac3bc0896b8659ad969821d317c;hp=b8ea9ffb6e2490efe0276309a32f8bdb56cffdd4;hpb=fe1b970ae7d324629fd8848c1c640940c87ecfb5;p=gitmo%2FClass-MOP.git diff --git a/lib/Class/MOP/Mixin/HasMethods.pm b/lib/Class/MOP/Mixin/HasMethods.pm index b8ea9ff..df91a13 100644 --- a/lib/Class/MOP/Mixin/HasMethods.pm +++ b/lib/Class/MOP/Mixin/HasMethods.pm @@ -3,7 +3,7 @@ package Class::MOP::Mixin::HasMethods; use strict; use warnings; -our $VERSION = '1.04'; +our $VERSION = '1.07'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; @@ -89,7 +89,7 @@ sub has_method { ( defined $method_name && length $method_name ) || confess "You must define a method name"; - return defined( $self->get_method($method_name) ); + return defined( $self->_get_maybe_raw_method($method_name) ); } sub get_method { @@ -98,6 +98,21 @@ sub get_method { ( defined $method_name && length $method_name ) || confess "You must define a method name"; + my $method = $self->_get_maybe_raw_method($method_name) + or return; + + return $method if blessed $method; + + return $self->_method_map->{$method_name} = $self->wrap_method_body( + body => $method, + name => $method_name, + associated_metaclass => $self, + ); +} + +sub _get_maybe_raw_method { + my ( $self, $method_name ) = @_; + my $method_map = $self->_method_map; my $map_entry = $method_map->{$method_name}; my $code = $self->get_package_symbol( @@ -119,13 +134,7 @@ sub get_method { return unless $code && $self->_code_is_mine($code); } - $code ||= $map_entry; - - return $method_map->{$method_name} = $self->wrap_method_body( - body => $code, - name => $method_name, - associated_metaclass => $self, - ); + return $code; } sub remove_method { @@ -152,7 +161,13 @@ sub get_method_list { my $namespace = $self->namespace; - return grep { *{ $namespace->{$_} }{CODE} && $self->has_method($_) } + # Constants may show up as some sort of reference in the namespace hash + # ref, depending on the Perl version. + return grep { + defined $namespace->{$_} + && ( ref $namespace->{$_} || *{ $namespace->{$_} }{CODE} ) + && $self->has_method($_) + } keys %{$namespace}; } @@ -164,7 +179,12 @@ sub _get_local_methods { my $namespace = $self->namespace; - return map { $self->get_method($_) } grep { *{ $namespace->{$_} }{CODE} } + return map { $self->get_method($_) } + grep { + defined $namespace->{$_} + && ( ref $namespace->{$_} + || *{ $namespace->{$_} }{CODE} ) + } keys %{$namespace}; }