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=79998a3d2d847f87ddf1de1d7ebd2a412e11ebd8;hp=9fd52b94487990ecf4484223157c153319058ddd;hb=31c5194bc6a176cec4de515163d27f174eba5c9b;hpb=53875581c2449e237cc1135b8c2cf1674a874aed diff --git a/lib/Mouse/Meta/Module.pm b/lib/Mouse/Meta/Module.pm index 9fd52b9..79998a3 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/get_code_info not_supported load_class :meta/; +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); } @@ -299,7 +304,15 @@ __END__ =head1 NAME -Mouse::Meta::Module - Common base class for Mouse::Meta::Class and Mouse::Meta::Role +Mouse::Meta::Module - The base class for Mouse::Meta::Class and Mouse::Meta::Role + +=head1 SEE ALSO + +L + +L + +L =cut