X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FModule.pm;h=df1f0bd4cee21fad4c91c2855a227702f32dbce5;hb=3e44140bf0332cf0e44055fd76c2ba43cd898161;hp=383f51d93f6e4e2e4aa57ec075aa3be06145239e;hpb=2591e962421f07deae90d93875aa129c57d841af;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Meta/Module.pm b/lib/Mouse/Meta/Module.pm index 383f51d..df1f0bd 100755 --- a/lib/Mouse/Meta/Module.pm +++ b/lib/Mouse/Meta/Module.pm @@ -1,5 +1,7 @@ package Mouse::Meta::Module; -use Mouse::Util qw/:meta get_code_package load_class not_supported/; # enables strict and warnings +use Mouse::Util qw/:meta get_code_package get_code_ref load_class not_supported/; # enables strict and warnings + +use Mouse::Util::TypeConstraints (); use Carp (); use Scalar::Util qw/blessed weaken/; @@ -67,28 +69,6 @@ sub get_attribute { $_[0]->{attributes}->{$_[1]} } sub get_attribute_list{ keys %{$_[0]->{attributes}} } sub remove_attribute { delete $_[0]->{attributes}->{$_[1]} } -sub add_method { - my($self, $name, $code) = @_; - - if(!defined $name){ - $self->throw_error('You must pass a defined name'); - } - if(!defined $code){ - $self->throw_error('You must pass a defined code'); - } - - if(ref($code) ne 'CODE'){ - $code = \&{$code}; # coerce - } - - $self->{methods}->{$name} = $code; # Moose stores meta object here. - - my $pkg = $self->name; - no strict 'refs'; - no warnings 'redefine', 'once'; - *{ $pkg . '::' . $name } = $code; -} - # XXX: for backward compatibility my %foreign = map{ $_ => undef } qw( Mouse Mouse::Role Mouse::Util Mouse::Util::TypeConstraints @@ -102,6 +82,8 @@ sub _code_is_mine{ return !exists $foreign{$package}; } +sub add_method; + sub has_method { my($self, $method_name) = @_; @@ -110,11 +92,7 @@ sub has_method { return 1 if $self->{methods}{$method_name}; - my $code = do{ - no strict 'refs'; - no warnings 'once'; - *{ $self->{package} . '::' . $method_name }{CODE}; - }; + my $code = get_code_ref($self->{package}, $method_name); return $code && $self->_code_is_mine($code); } @@ -126,12 +104,7 @@ sub get_method_body{ or $self->throw_error('You must define a method name'); return $self->{methods}{$method_name} ||= do{ - my $code = do{ - no strict 'refs'; - no warnings 'once'; - *{$self->{package} . '::' . $method_name}{CODE}; - }; - + my $code = get_code_ref($self->{package}, $method_name); ($code && $self->_code_is_mine($code)) ? $code : undef; }; } @@ -173,7 +146,7 @@ sub get_method_list { my $superclasses; if(exists $options{superclasses}){ - if($self->isa('Mouse::Meta::Role')){ + if(Mouse::Util::TypeConstraints::_is_a_metarole($self)){ delete $options{superclasses}; } else{ @@ -320,7 +293,7 @@ Mouse::Meta::Module - The base class for Mouse::Meta::Class and Mouse::Meta::Rol =head1 VERSION -This document describes Mouse version 0.40 +This document describes Mouse version 0.40_01 =head1 SEE ALSO