X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FModule.pm;h=c102596bd65b99c2196a70b831b00ebec7ba49b1;hp=f71c60c628cda109ade99b3a0d4628f71541eab4;hb=319200322d3631cdd936d6e36aa081d1caa2e7e1;hpb=1820fffecb0bd1da64edc16ecde534178b841d14 diff --git a/lib/Mouse/Meta/Module.pm b/lib/Mouse/Meta/Module.pm index f71c60c..c102596 100755 --- a/lib/Mouse/Meta/Module.pm +++ b/lib/Mouse/Meta/Module.pm @@ -5,7 +5,7 @@ use warnings; use Carp (); use Scalar::Util qw/blessed weaken/; -use Mouse::Util qw/:meta get_code_info not_supported load_class/; +use Mouse::Util qw/:meta get_code_package not_supported load_class/; { my %METACLASS_CACHE; @@ -97,20 +97,25 @@ sub add_method { *{ $pkg . '::' . $name } = $code; } -sub _code_is_mine { # taken from Class::MOP::Class - my ( $self, $code ) = @_; +# XXX: for backward compatibility +my %foreign = map{ $_ => undef } qw( + Mouse Mouse::Role Mouse::Util Mouse::Util::TypeConstraints + Carp Scalar::Util +); +sub _code_is_mine{ + my($self, $code) = @_; - my ( $code_package, $code_name ) = get_code_info($code); + my $package = get_code_package($code); - return $code_package && $code_package eq $self->name - || ( $code_package eq 'constant' && $code_name eq '__ANON__' ); + return !exists $foreign{$package}; } sub has_method { my($self, $method_name) = @_; return 1 if $self->{methods}->{$method_name}; - my $code = $self->name->can($method_name); + + my $code = do{ no strict 'refs'; *{$self->{package} . '::' . $method_name}{CODE} }; return $code && $self->_code_is_mine($code); } @@ -301,5 +306,9 @@ __END__ Mouse::Meta::Module - The base class for Mouse::Meta::Class and Mouse::Meta::Role +=head1 SEE ALSO + +L + =cut