From: Scott McWhirter Date: Wed, 28 May 2008 01:27:19 +0000 (+0000) Subject: Inline some reused variables. X-Git-Tag: 0_64~47 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9c412f31d843943da5df95a56c0cadb1222602a0;p=gitmo%2FClass-MOP.git Inline some reused variables. --- diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm index 48dd0b6..89cb5e5 100644 --- a/lib/Class/MOP/Class.pm +++ b/lib/Class/MOP/Class.pm @@ -151,6 +151,8 @@ sub check_metaclass_compatability { my @class_list = $self->linearized_isa; shift @class_list; # shift off $self->name + my $name = $self->name; + foreach my $class_name (@class_list) { my $meta = Class::MOP::get_metaclass_by_name($class_name) || next; @@ -163,14 +165,14 @@ sub check_metaclass_compatability { : blessed($meta)); ($self->isa($meta_type)) - || confess $self->name . "->meta => (" . (blessed($self)) . ")" . + || confess $name . "->meta => (" . (blessed($self)) . ")" . " is not compatible with the " . $class_name . "->meta => (" . ($meta_type) . ")"; # NOTE: # we also need to check that instance metaclasses # are compatabile in the same the class. ($self->instance_metaclass->isa($meta->instance_metaclass)) - || confess $self->name . "->meta => (" . ($self->instance_metaclass) . ")" . + || confess $name . "->meta => (" . ($self->instance_metaclass) . ")" . " is not compatible with the " . $class_name . "->meta => (" . ($meta->instance_metaclass) . ")"; } @@ -213,8 +215,9 @@ sub check_metaclass_compatability { sub DESTROY { my $self = shift; no warnings 'uninitialized'; - return unless $self->name =~ /^$ANON_CLASS_PREFIX/; - my ($serial_id) = ($self->name =~ /^$ANON_CLASS_PREFIX(\d+)/); + my $name = $self->name; + return unless $name =~ /^$ANON_CLASS_PREFIX/; + my ($serial_id) = ($name =~ /^$ANON_CLASS_PREFIX(\d+)/); no strict 'refs'; foreach my $key (keys %{$ANON_CLASS_PREFIX . $serial_id}) { delete ${$ANON_CLASS_PREFIX . $serial_id}{$key}; @@ -392,8 +395,11 @@ sub get_meta_instance { sub clone_object { my $class = shift; my $instance = shift; - (blessed($instance) && $instance->isa($class->name)) - || confess "You must pass an instance ($instance) of the metaclass (" . $class->name . ")"; + + my $name = $class->name; + + (blessed($instance) && $instance->isa($name)) + || confess "You must pass an instance ($instance) of the metaclass (" . $name . ")"; # NOTE: # we need to protect the integrity of the # Class::MOP::Class singletons here, they @@ -421,6 +427,7 @@ sub clone_instance { sub rebless_instance { my ($self, $instance, %params) = @_; + my $old_metaclass; if ($instance->can('meta')) { ($instance->meta->isa('Class::MOP::Class')) @@ -432,9 +439,11 @@ sub rebless_instance { } my $meta_instance = $self->get_meta_instance(); - - $self->name->isa($old_metaclass->name) - || confess "You may rebless only into a subclass of (". $old_metaclass->name ."), of which (". $self->name .") isn't."; + my $name = $self->name; + my $old_name = $old_metaclass->name; + + $name->isa($old_name) + || confess "You may rebless only into a subclass of (". $old_name ."), of which (". $name .") isn't."; # rebless! $meta_instance->rebless_instance_structure($instance, $self); @@ -566,16 +575,17 @@ sub add_method { (defined $method_name && $method_name) || confess "You must define a method name"; + my $name = $self->name; my $body; if (blessed($method)) { $body = $method->body; - if ($method->package_name ne $self->name && + if ($method->package_name ne $name && $method->name ne $method_name) { warn "Hello there, got somethig for you." . " Method says " . $method->package_name . " " . $method->name - . " Class says " . $self->name . " " . $method_name; + . " Class says " . $name . " " . $method_name; $method = $method->clone( - package_name => $self->name, + package_name => $name, name => $method_name ) if $method->can('clone'); } @@ -586,14 +596,14 @@ sub add_method { || confess "Your code block must be a CODE reference"; $method = $self->method_metaclass->wrap( $body => ( - package_name => $self->name, + package_name => $name, name => $method_name ) ); } $self->get_method_map->{$method_name} = $method; - my $full_method_name = ($self->name . '::' . $method_name); + my $full_method_name = ($name . '::' . $method_name); $self->add_package_symbol("&${method_name}" => Class::MOP::subname($full_method_name => $body) ); @@ -809,12 +819,13 @@ sub add_attribute { # name here so that we can properly detach # the old attr object, and remove any # accessors it would have generated - $self->remove_attribute($attribute->name) - if $self->has_attribute($attribute->name); + my $attr_name = $attribute->name; + $self->remove_attribute($attr_name) + if $self->has_attribute($attr_name); # then onto installing the new accessors $attribute->install_accessors(); - $self->get_attribute_map->{$attribute->name} = $attribute; + $self->get_attribute_map->{$attr_name} = $attribute; } sub has_attribute {