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=dd463138834023c4d51677d8b6e3a313d8e2c6ab;hp=d711877cc6426106c484e2e34b75d0a49552c294;hb=HEAD;hpb=1d76ae62bb4a259c0c107f1937e9db9f49ce8e10 diff --git a/lib/Mouse/Meta/Module.pm b/lib/Mouse/Meta/Module.pm index d711877..dd46313 100644 --- a/lib/Mouse/Meta/Module.pm +++ b/lib/Mouse/Meta/Module.pm @@ -14,12 +14,6 @@ if(Mouse::Util::MOUSE_XS){ *CLONE = sub { Mouse::Util::__register_metaclass_storage(\%METAS, 1) }; } -sub _metaclass_cache { # DEPRECATED - my($self, $name) = @_; - Carp::cluck('_metaclass_cache() has been deprecated. Use Mouse::Util::get_metaclass_by_name() instead'); - return $METAS{$name}; -} - sub initialize { my($class, $package_name, @args) = @_; @@ -52,7 +46,8 @@ sub _class_of{ } # Means of accessing all the metaclasses that have -# been initialized thus far +# been initialized thus far. +# The public versions are aliased into Mouse::Util::*. #sub _get_all_metaclasses { %METAS } sub _get_all_metaclass_instances { values %METAS } sub _get_all_metaclass_names { keys %METAS } @@ -79,44 +74,40 @@ sub remove_attribute { delete $_[0]->{attributes}->{$_[1]} } sub get_attribute_list{ keys %{$_[0]->{attributes}} } -# XXX: for backward compatibility +# XXX: not completely compatible with Moose my %foreign = map{ $_ => undef } qw( Mouse Mouse::Role Mouse::Util Mouse::Util::TypeConstraints Carp Scalar::Util List::Util ); -sub _code_is_mine{ -# my($self, $code) = @_; - - return !exists $foreign{ Mouse::Util::get_code_package($_[1]) }; +sub _get_method_body { + my($self, $method_name) = @_; + my $code = Mouse::Util::get_code_ref($self->{package}, $method_name); + return $code && !exists $foreign{ Mouse::Util::get_code_package($code) } + ? $code + : undef; } sub add_method; sub has_method { my($self, $method_name) = @_; - defined($method_name) or $self->throw_error('You must define a method name'); - return defined($self->{methods}{$method_name}) || do{ - my $code = Mouse::Util::get_code_ref($self->{package}, $method_name); - $code && $self->_code_is_mine($code); - }; + return defined( $self->{methods}{$method_name} ) + || defined( $self->_get_method_body($method_name) ); } sub get_method_body { my($self, $method_name) = @_; - defined($method_name) or $self->throw_error('You must define a method name'); - return $self->{methods}{$method_name} ||= do{ - my $code = Mouse::Util::get_code_ref($self->{package}, $method_name); - $code && $self->_code_is_mine($code) ? $code : undef; - }; + return $self->{methods}{$method_name} + ||= $self->_get_method_body($method_name); } -sub get_method{ +sub get_method { my($self, $method_name) = @_; if(my $code = $self->get_method_body($method_name)){ @@ -137,7 +128,7 @@ sub get_method_list { return grep { $self->has_method($_) } keys %{ $self->namespace }; } -sub _collect_methods { # Mouse specific +sub _collect_methods { # Mouse specific, used for method modifiers my($meta, @args) = @_; my @methods; @@ -223,6 +214,7 @@ sub create { $package_name = $class . '::__ANON__::' . $ANON_SERIAL; } + # instantiate a module { no strict 'refs'; @@ -232,7 +224,7 @@ sub create { my $meta = $self->initialize( $package_name, %options); - Scalar::Util::weaken $METAS{$package_name} + Scalar::Util::weaken($METAS{$package_name}) if $mortal; $meta->add_method(meta => sub { @@ -266,7 +258,7 @@ sub create { $meta->add_method($method_name, $method_body); } } - if (defined $roles){ + if (defined $roles and !$options{in_application_to_instance}){ Mouse::Util::apply_all_roles($package_name, @{$roles}); } @@ -319,7 +311,7 @@ Mouse::Meta::Module - The common base class of Mouse::Meta::Class and Mouse::Met =head1 VERSION -This document describes Mouse version 0.73 +This document describes Mouse version 0.95 =head1 DESCRIPTION