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=44e990dbf1fccbffb9a986df8e88f0d6236d409a;hp=9e1787faf8fba04996491a90f2fb662d40f44fc5;hb=2125ee6b834fe1e8e917df6e1bf7f7059d9579fc;hpb=a25ca8d637c040b2f929b1a23dd62ff63d85f5d1 diff --git a/lib/Mouse/Meta/Module.pm b/lib/Mouse/Meta/Module.pm index 9e1787f..44e990d 100755 --- a/lib/Mouse/Meta/Module.pm +++ b/lib/Mouse/Meta/Module.pm @@ -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) = @_; @@ -91,7 +85,7 @@ sub add_method { my $pkg = $self->name; no strict 'refs'; - no warnings 'redefine'; + no warnings 'redefine', 'once'; *{ $pkg . '::' . $name } = $code; } @@ -116,10 +110,7 @@ sub has_method { return 1 if $self->{methods}{$method_name}; - my $code = do{ - no strict 'refs'; - *{ $self->{package} . '::' . $method_name }{CODE}; - }; + my $code = $self->_get_code_ref($method_name); return $code && $self->_code_is_mine($code); } @@ -131,8 +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'; *{$self->{package} . '::' . $method_name}{CODE} }; - + my $code = $self->_get_code_ref($method_name); ($code && $self->_code_is_mine($code)) ? $code : undef; }; } @@ -144,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, ); } @@ -321,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.37_06 +This document describes Mouse version 0.40 =head1 SEE ALSO