From: Dave Rolsky Date: Fri, 10 Sep 2010 02:14:59 +0000 (-0500) Subject: Just cache does_role for immutabilized classes - no need for an inlined method X-Git-Tag: 1.13~9 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=90a49845bc9a7aacb148ce8594f89ee2ede61c9e;p=gitmo%2FMoose.git Just cache does_role for immutabilized classes - no need for an inlined method --- diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm index 47c7764..89b9230 100644 --- a/lib/Moose/Meta/Class.pm +++ b/lib/Moose/Meta/Class.pm @@ -22,7 +22,6 @@ use Moose::Error::Default; use Moose::Meta::Class::Immutable::Trait; use Moose::Meta::Method::Constructor; use Moose::Meta::Method::Destructor; -use Moose::Meta::Method::Does; use base 'Class::MOP::Class'; @@ -53,11 +52,6 @@ __PACKAGE__->meta->add_attribute('destructor_class' => ( default => 'Moose::Meta::Method::Destructor', )); -__PACKAGE__->meta->add_attribute('does_class' => ( - accessor => 'does_class', - default => 'Moose::Meta::Method::Does', -)); - __PACKAGE__->meta->add_attribute('error_class' => ( accessor => 'error_class', default => 'Moose::Error::Default', @@ -139,7 +133,6 @@ sub reinitialize { instance_metaclass constructor_class destructor_class - does_class error_class ); @@ -654,7 +647,6 @@ sub _immutable_options { $self->SUPER::_immutable_options( inline_destructor => 1, - inline_does => 1, # Moose always does this when an attribute is created inline_accessors => 0, @@ -663,37 +655,6 @@ sub _immutable_options { ); } -sub _install_inlined_code { - my ( $self, %args ) = @_; - - $self->SUPER::_install_inlined_code(%args); - - $self->_inline_does(%args) if $args{inline_does}; -} - -sub _inline_does { - my ( $self, %args ) = @_; - - if ( $self->has_method('does') ) { - my $class = $self->name; - warn "Not inlining a does method for $class since it defines" - . " its own does().\n"; - return; - } - - my $does = $self->does_class->new( - options => \%args, - metaclass => $self, - is_inline => 1, - package_name => $self->name, - ); - - if ( $args{replace_does} or $does->can_be_inlined ) { - $self->add_method( 'does' => $does ); - $self->_add_inlined_method($does); - } -} - ## ------------------------------------------------- our $error_level; @@ -812,10 +773,6 @@ enables inlining the destructor. Since Moose always inlines attributes, it sets the C option to false. -Because Moose attempts to inline C when possible, this method accepts -C and C options. The default is to inline the does -method, but an existing does method in a parent will not be replaced. - =item B<< $metaclass->new_object(%params) >> This overrides the parent's method in order to add support for @@ -885,13 +842,10 @@ be provided as a hash reference. =item B<< $metaclass->destructor_class($class_name) >> -=item B<< $metaclass->does_class($class_name) >> - These are the names of classes used when making a class immutable. These -default to L, -L, and L -respectively. These accessors are read-write, so you can use them to change -the class name. +default to L and +L respectively. These accessors are +read-write, so you can use them to change the class name. =item B<< $metaclass->error_class($class_name) >> diff --git a/lib/Moose/Meta/Class/Immutable/Trait.pm b/lib/Moose/Meta/Class/Immutable/Trait.pm index 60f6832..7a2f4e0 100644 --- a/lib/Moose/Meta/Class/Immutable/Trait.pm +++ b/lib/Moose/Meta/Class/Immutable/Trait.pm @@ -4,6 +4,7 @@ use strict; use warnings; use Class::MOP; +use Scalar::Util qw( blessed ); our $VERSION = '1.12'; $VERSION = eval $VERSION; @@ -25,6 +26,21 @@ sub calculate_all_roles_with_inheritance { @{ $self->{__immutable}{calculate_all_roles_with_inheritance} ||= [ $self->$orig ] }; } +sub does_role { + shift; + my $self = shift; + my $role = shift; + + (defined $role) + || $self->throw_error("You must supply a role name to look for"); + + $self->{__immutable}{does_role} ||= { map { $_->name => 1 } $self->calculate_all_roles_with_inheritance }; + + my $name = blessed $role ? $role->name : $role; + + return $self->{__immutable}{does_role}{$name}; +} + 1; __END__ diff --git a/lib/Moose/Meta/Method/Does.pm b/lib/Moose/Meta/Method/Does.pm deleted file mode 100644 index 805603a..0000000 --- a/lib/Moose/Meta/Method/Does.pm +++ /dev/null @@ -1,141 +0,0 @@ -package Moose::Meta::Method::Does; - -use strict; -use warnings; - -use Scalar::Util 'blessed', 'weaken', 'looks_like_number', 'refaddr'; - -our $VERSION = '1.12'; -our $AUTHORITY = 'cpan:STEVAN'; - -use base 'Moose::Meta::Method', - 'Class::MOP::Method::Inlined'; - -sub new { - my $class = shift; - my %options = @_; - - my $meta = $options{metaclass}; - - ( ref $options{options} eq 'HASH' ) - || $class->throw_error( "You must pass a hash of options", - data => $options{options} ); - - $options{package_name} - || $class->throw_error( - "You must supply the package_name parameter" ); - - my $self = bless { - 'body' => undef, - 'package_name' => $options{package_name}, - 'name' => 'does', - 'options' => $options{options}, - 'associated_metaclass' => $meta, - '_expected_method_class' => $options{_expected_method_class} - || 'Moose::Object', - } => $class; - - weaken( $self->{'associated_metaclass'} ); - - $self->_initialize_body; - - return $self; -} - -sub _initialize_body { - my $self = shift; - - my $source = 'sub {'; - $source - .= "\n" - . 'defined $_[1] || ' - . $self->_inline_throw_error( - q{"You must supply a role name to does()"}); - $source .= ";\n" . 'my $name = Scalar::Util::blessed( $_[1] ) ? $_[1]->name : $_[1]'; - $source .= ";\n" . 'return $does{$name} || 0'; - $source .= ";\n" . '}'; - - my %does = map { $_->name => 1 } - $self->associated_metaclass->calculate_all_roles_with_inheritance; - - my ( $code, $e ) = $self->_compile_code( - code => $source, - environment => { - '%does' => \%does, - '$meta' => \$self, - }, - ); - - $self->throw_error( - "Could not eval the does method :\n\n$source\n\nbecause :\n\n$e", - error => $e, - data => $source, - ) if $e; - - $self->{'body'} = $code; -} - -1; - -__END__ - -=pod - -=head1 NAME - -Moose::Meta::Method::Does - Method Meta Object for does - -=head1 DESCRIPTION - -This class is a subclass of L that provides -Moose-specific functionality for inlining does. - -To understand this class, you should read the L -documentation as well. - -=head1 INHERITANCE - -C is a subclass of -L I L. - -=head1 METHODS - -=over 4 - -=item B<< Moose::Meta::Method::Does->new(%options) >> - -This constructs a new object. It accepts the following options: - -=over 8 - -=item * package_name - -The package for the class in which the does is being inlined. This option is -required. - -=item * metaclass - -The metaclass for the class this does belongs to. This is optional, as it can -be set later by calling C<< $metamethod->attach_to_class >>. - -=back - -=head1 BUGS - -See L for details on reporting bugs. - -=head1 AUTHORS - -Stevan Little Estevan@iinteractive.comE - -=head1 COPYRIGHT AND LICENSE - -Copyright 2010 by Infinity Interactive, Inc. - -L - -This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. - -=cut -