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=132e4afc047f1b5769a6c537bbddd1edebb65243;hp=227313e4bb060b3a85a2a1fb065f153bacd7acae;hb=b06ce1f502945c13a52c503f1a651fe92c91c773;hpb=034587d897c53d4df84085a9229334bd2d51f1c6 diff --git a/lib/Mouse/Meta/Module.pm b/lib/Mouse/Meta/Module.pm index 227313e..132e4af 100755 --- a/lib/Mouse/Meta/Module.pm +++ b/lib/Mouse/Meta/Module.pm @@ -1,5 +1,5 @@ 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 Carp (); use Scalar::Util qw/blessed weaken/; @@ -38,9 +38,9 @@ sub get_metaclass_by_name { $METAS{$_[0]} } #sub does_metaclass_exist { defined $METAS{$_[0]} } #sub remove_metaclass_by_name { delete $METAS{$_[0]} } +sub name; - -sub name { $_[0]->{package} } +sub namespace; # The followings are Class::MOP specific methods @@ -67,12 +67,6 @@ sub get_attribute { $_[0]->{attributes}->{$_[1]} } sub get_attribute_list{ keys %{$_[0]->{attributes}} } sub remove_attribute { delete $_[0]->{attributes}->{$_[1]} } -sub namespace{ - my $name = $_[0]->{package}; - no strict 'refs'; - return \%{ $name . '::' }; -} - sub add_method { my($self, $name, $code) = @_; @@ -116,11 +110,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); } @@ -132,12 +122,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; }; } @@ -149,11 +134,11 @@ sub get_method{ my $method_metaclass = $self->method_metaclass; load_class($method_metaclass); - my $package = $self->name; - return $method_metaclass->new( - body => $package->can($method_name), - name => $method_name, - package => $package, + return $method_metaclass->wrap( + body => $self->get_method_body($method_name), + name => $method_name, + package => $self->name, + associated_metaclass => $self, ); } @@ -326,7 +311,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