use Try::Tiny;
use List::MoreUtils 'all';
-our $VERSION = '1.01';
+our $VERSION = '1.03';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
return $meta;
}
- # NOTE:
- # we need to deal with the possibility
- # of class immutability here, and then
- # get the name of the class appropriately
- $class = (ref($class)
- ? ($class->is_immutable
- ? $class->_get_mutable_metaclass_name()
- : ref($class))
- : $class);
+ $class
+ = ref $class
+ ? $class->_real_ref_name
+ : $class;
# now create the metaclass
my $meta;
$meta;
}
+sub _real_ref_name {
+ my $self = shift;
+
+ # NOTE: we need to deal with the possibility of class immutability here,
+ # and then get the name of the class appropriately
+ return $self->is_immutable
+ ? $self->_get_mutable_metaclass_name()
+ : ref $self;
+}
+
sub _new {
my $class = shift;
my $super_meta = Class::MOP::get_metaclass_by_name($superclass_name)
|| return 1;
- # NOTE:
- # we need to deal with the possibility
- # of class immutability here, and then
- # get the name of the class appropriately
- my $super_meta_type
- = $super_meta->is_immutable
- ? $super_meta->_get_mutable_metaclass_name()
- : ref($super_meta);
+ my $super_meta_type = $super_meta->_real_ref_name;
return $self->isa($super_meta_type);
}
if (!$self->_class_metaclass_is_compatible($superclass_name)) {
my $super_meta = Class::MOP::get_metaclass_by_name($superclass_name);
- # NOTE:
- # we need to deal with the possibility
- # of class immutability here, and then
- # get the name of the class appropriately
- my $super_meta_type
- = $super_meta->is_immutable
- ? $super_meta->_get_mutable_metaclass_name()
- : ref($super_meta);
+ my $super_meta_type = $super_meta->_real_ref_name;
confess "The metaclass of " . $self->name . " ("
. (ref($self)) . ")" . " is not compatible with "
return 1 unless $super_meta->can($metaclass_type);
# for instance, Moose::Meta::Class has a destructor_class, but
# Class::MOP::Class doesn't - this shouldn't be an error
- return 1 if defined $self->$metaclass_type
- && !defined $super_meta->$metaclass_type;
+ return 1 unless defined $super_meta->$metaclass_type;
+ # if metaclass is defined in superclass but not here, it's not compatible
+ # this is a really odd case
+ return 0 unless defined $self->$metaclass_type;
return $self->$metaclass_type->isa($super_meta->$metaclass_type);
}
my $self = shift;
my ($super_meta) = @_;
- # NOTE:
- # we need to deal with the possibility
- # of class immutability here, and then
- # get the name of the class appropriately
- my $super_meta_type
- = $super_meta->is_immutable
- ? $super_meta->_get_mutable_metaclass_name()
- : ref($super_meta);
+ my $super_meta_type = $super_meta->_real_ref_name;
return $super_meta_type ne blessed($self)
&& $super_meta->isa(blessed($self));
# for instance, Moose::Meta::Class has a destructor_class, but
# Class::MOP::Class doesn't - this shouldn't be an error
- return if defined $specific_meta
- && !defined $super_specific_meta;
+ return unless defined $super_specific_meta;
+
+ # if metaclass is defined in superclass but not here, it's fixable
+ # this is a really odd case
+ return 1 unless defined $specific_meta;
return $specific_meta ne $super_specific_meta
&& $super_specific_meta->isa($specific_meta);
my %base_metaclass = $self->_base_metaclasses;
for my $metaclass_type (keys %base_metaclass) {
- next unless defined $self->$metaclass_type;
return 1 if $self->_can_fix_single_metaclass_incompatibility_by_subclassing($metaclass_type, $super_meta);
}
sub _fix_metaclass_incompatibility {
my $self = shift;
- my @supers = @_;
+ my @supers = map { Class::MOP::Class->initialize($_) } @_;
my $necessary = 0;
- for my $super (map { Class::MOP::Class->initialize($_) } @supers) {
+ for my $super (@supers) {
$necessary = 1
if $self->_can_fix_metaclass_incompatibility($super);
}
return unless $necessary;
- ($self->is_pristine)
- || confess "Can't fix metaclass incompatibility for "
- . $self->name
- . " because it is not pristine.";
-
- for my $super (map { Class::MOP::Class->initialize($_) } @supers) {
+ for my $super (@supers) {
if (!$self->_class_metaclass_is_compatible($super->name)) {
$self->_fix_class_metaclass_incompatibility($super);
}
my %base_metaclass = $self->_base_metaclasses;
for my $metaclass_type (keys %base_metaclass) {
- next unless defined $self->$metaclass_type;
- for my $super (map { Class::MOP::Class->initialize($_) } @supers) {
+ for my $super (@supers) {
if (!$self->_single_metaclass_is_compatible($metaclass_type, $super->name)) {
$self->_fix_single_metaclass_incompatibility(
$metaclass_type, $super
my ( $super_meta ) = @_;
if ($self->_can_fix_class_metaclass_incompatibility_by_subclassing($super_meta)) {
- my $super_meta_name = $super_meta->is_immutable
- ? $super_meta->_get_mutable_metaclass_name
- : blessed($super_meta);
+ ($self->is_pristine)
+ || confess "Can't fix metaclass incompatibility for "
+ . $self->name
+ . " because it is not pristine.";
+
+ my $super_meta_name = $super_meta->_real_ref_name;
+
$super_meta_name->meta->rebless_instance($self);
}
}
my ( $metaclass_type, $super_meta ) = @_;
if ($self->_can_fix_single_metaclass_incompatibility_by_subclassing($metaclass_type, $super_meta)) {
+ ($self->is_pristine)
+ || confess "Can't fix metaclass incompatibility for "
+ . $self->name
+ . " because it is not pristine.";
+
$self->{$metaclass_type} = $super_meta->$metaclass_type;
}
}
# metaclass roles applied (via Moose), then we want to make sure
# that we preserve that anonymous class (see Fey::ORM for an
# example of where this matters).
- my $meta_name
- = $meta->is_immutable
- ? $meta->_get_mutable_metaclass_name
- : ref $meta;
+ my $meta_name = $meta->_real_ref_name;
my $immutable_meta = $meta_name->create(
$class_name,