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=d83ea124ebd0f54cf495dc84bf1ab30e291e3222;hp=132e4afc047f1b5769a6c537bbddd1edebb65243;hb=f48920c11c806b2a1fd60be145ff2cdf79750878;hpb=b06ce1f502945c13a52c503f1a651fe92c91c773 diff --git a/lib/Mouse/Meta/Module.pm b/lib/Mouse/Meta/Module.pm index 132e4af..d83ea12 100755 --- a/lib/Mouse/Meta/Module.pm +++ b/lib/Mouse/Meta/Module.pm @@ -1,8 +1,10 @@ package Mouse::Meta::Module; 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/; +use Mouse::Util::TypeConstraints (); + +use Carp (); +use Scalar::Util (); my %METAS; @@ -67,55 +69,32 @@ 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 - Carp Scalar::Util + Carp Scalar::Util List::Util ); sub _code_is_mine{ - my($self, $code) = @_; +# my($self, $code) = @_; - my $package = get_code_package($code); - - return !exists $foreign{$package}; + return !exists $foreign{ get_code_package($_[1]) }; } +sub add_method; + sub has_method { my($self, $method_name) = @_; defined($method_name) or $self->throw_error('You must define a method name'); - return 1 if $self->{methods}{$method_name}; - - my $code = get_code_ref($self->{package}, $method_name); - - return $code && $self->_code_is_mine($code); + return defined($self->{methods}{$method_name}) || do{ + my $code = get_code_ref($self->{package}, $method_name); + $code && $self->_code_is_mine($code); + }; } -sub get_method_body{ +sub get_method_body { my($self, $method_name) = @_; defined($method_name) @@ -123,19 +102,19 @@ sub get_method_body{ return $self->{methods}{$method_name} ||= do{ my $code = get_code_ref($self->{package}, $method_name); - ($code && $self->_code_is_mine($code)) ? $code : undef; + $code && $self->_code_is_mine($code) ? $code : undef; }; } sub get_method{ my($self, $method_name) = @_; - if($self->has_method($method_name)){ + if(my $code = $self->get_method_body($method_name)){ my $method_metaclass = $self->method_metaclass; load_class($method_metaclass); return $method_metaclass->wrap( - body => $self->get_method_body($method_name), + body => $code, name => $method_name, package => $self->name, associated_metaclass => $self, @@ -164,7 +143,7 @@ sub get_method_list { my $superclasses; if(exists $options{superclasses}){ - if($self->isa('Mouse::Meta::Role')){ + if(Mouse::Util::is_a_metarole($self)){ delete $options{superclasses}; } else{ @@ -217,7 +196,7 @@ sub get_method_list { my $meta = $self->initialize( $package_name, %options); - weaken $METAS{$package_name} + Scalar::Util::weaken $METAS{$package_name} if $mortal; $meta->add_method(meta => sub{ @@ -311,7 +290,7 @@ Mouse::Meta::Module - The base class for Mouse::Meta::Class and Mouse::Meta::Rol =head1 VERSION -This document describes Mouse version 0.40_01 +This document describes Mouse version 0.40_03 =head1 SEE ALSO