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;
: 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) . ")";
}
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};
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
sub rebless_instance {
my ($self, $instance, %params) = @_;
+
my $old_metaclass;
if ($instance->can('meta')) {
($instance->meta->isa('Class::MOP::Class'))
}
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);
(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');
}
|| 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)
);
# 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 {