my $package_name = shift;
(defined $package_name && $package_name && !blessed($package_name))
|| confess "You must pass a package name and it cannot be blessed";
- if (defined(my $meta = Class::MOP::get_metaclass_by_name($package_name))) {
- return $meta;
- }
- $class->construct_class_instance('package' => $package_name, @_);
+ return Class::MOP::get_metaclass_by_name($package_name)
+ || $class->construct_class_instance('package' => $package_name, @_);
}
sub reinitialize {
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 $name . "->meta => (" . (blessed($self)) . ")" .
+ || confess $self->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 $name . "->meta => (" . ($self->instance_metaclass) . ")" .
+ || confess $self->name . "->meta => (" . ($self->instance_metaclass) . ")" .
" is not compatible with the " .
$class_name . "->meta => (" . ($meta->instance_metaclass) . ")";
}
sub DESTROY {
my $self = shift;
no warnings 'uninitialized';
- my $name = $self->name;
- return unless $name =~ /^$ANON_CLASS_PREFIX/;
- my ($serial_id) = ($name =~ /^$ANON_CLASS_PREFIX(\d+)/);
+ return unless $self->name =~ /^$ANON_CLASS_PREFIX/;
+ my ($serial_id) = ($self->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;
-
- my $name = $class->name;
-
- (blessed($instance) && $instance->isa($name))
- || confess "You must pass an instance ($instance) of the metaclass (" . $name . ")";
+ (blessed($instance) && $instance->isa($class->name))
+ || confess "You must pass an instance ($instance) of the metaclass (" . $class->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();
- 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.";
+
+ $self->name->isa($old_metaclass->name)
+ || confess "You may rebless only into a subclass of (". $old_metaclass->name ."), of which (". $self->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 $name &&
+ if ($method->package_name ne $self->name &&
$method->name ne $method_name) {
warn "Hello there, got somethig for you."
. " Method says " . $method->package_name . " " . $method->name
- . " Class says " . $name . " " . $method_name;
+ . " Class says " . $self->name . " " . $method_name;
$method = $method->clone(
- package_name => $name,
+ package_name => $self->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 => $name,
+ package_name => $self->name,
name => $method_name
)
);
}
$self->get_method_map->{$method_name} = $method;
- my $full_method_name = ($name . '::' . $method_name);
+ my $full_method_name = ($self->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
- my $attr_name = $attribute->name;
- $self->remove_attribute($attr_name)
- if $self->has_attribute($attr_name);
+ $self->remove_attribute($attribute->name)
+ if $self->has_attribute($attribute->name);
# then onto installing the new accessors
$attribute->install_accessors();
- $self->get_attribute_map->{$attr_name} = $attribute;
+ $self->get_attribute_map->{$attribute->name} = $attribute;
}
sub has_attribute {