use Try::Tiny;
use List::MoreUtils 'all';
-our $VERSION = '1.01';
+our $VERSION = '1.08';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
sub _check_metaclass_compatibility {
my $self = shift;
- if (my @superclasses = $self->superclasses) {
- $self->_fix_metaclass_incompatibility(@superclasses);
+ my @superclasses = $self->superclasses
+ or return;
+
+ $self->_fix_metaclass_incompatibility(@superclasses);
- my %base_metaclass = $self->_base_metaclasses;
+ my %base_metaclass = $self->_base_metaclasses;
- # this is always okay ...
- return if ref($self) eq 'Class::MOP::Class'
+ # this is always okay ...
+ return
+ if ref($self) eq 'Class::MOP::Class'
&& all {
my $meta = $self->$_;
- !defined($meta) || $meta eq $base_metaclass{$_}
- } keys %base_metaclass;
-
- for my $superclass (@superclasses) {
- $self->_check_class_metaclass_compatibility($superclass);
+ !defined($meta) || $meta eq $base_metaclass{$_};
}
+ keys %base_metaclass;
- for my $metaclass_type (keys %base_metaclass) {
- next unless defined $self->$metaclass_type;
- for my $superclass (@superclasses) {
- $self->_check_single_metaclass_compatibility(
- $metaclass_type, $superclass
- );
- }
+ for my $superclass (@superclasses) {
+ $self->_check_class_metaclass_compatibility($superclass);
+ }
+
+ for my $metaclass_type ( keys %base_metaclass ) {
+ next unless defined $self->$metaclass_type;
+ for my $superclass (@superclasses) {
+ $self->_check_single_metaclass_compatibility( $metaclass_type,
+ $superclass );
}
}
}
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);
}
. $self->name . " (" . ($self->$metaclass_type)
. ")" . " is not compatible with the "
. "$metaclass_type_name metaclass of its "
- . "superclass, " . $superclass_name . " ("
+ . "superclass, $superclass_name ("
. ($super_meta->$metaclass_type) . ")";
}
}
# 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;
- 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
# FIXME totally lame
$meta->add_method('meta' => sub {
+ if (Class::MOP::DEBUG_NO_META()) {
+ my ($self) = @_;
+ if (my $meta = try { $self->SUPER::meta }) {
+ return $meta if $meta->isa('Class::MOP::Class');
+ }
+ confess "'meta' method called by MOP internals"
+ if caller =~ /Class::MOP|metaclass/;
+ }
$class->initialize(ref($_[0]) || $_[0]);
});
sub superclasses {
my $self = shift;
- my $var_spec = { sigil => '@', type => 'ARRAY', name => 'ISA' };
+
+ my $isa = $self->get_or_add_package_symbol(
+ { sigil => '@', type => 'ARRAY', name => 'ISA' } );
+
if (@_) {
my @supers = @_;
- @{$self->get_package_symbol($var_spec)} = @supers;
+ @{$isa} = @supers;
# NOTE:
# on 5.8 and below, we need to call
$self->_check_metaclass_compatibility();
$self->_superclasses_updated();
}
- @{$self->get_package_symbol($var_spec)};
+
+ return @{$isa};
}
sub _superclasses_updated {
for my $class ( reverse $self->linearized_isa ) {
my $meta = Class::MOP::Class->initialize($class);
- $methods{$_} = $meta->get_method($_)
- for $meta->get_method_list;
+ $methods{ $_->name } = $_ for $meta->_get_local_methods;
}
return values %methods;
# 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,
=item B<< $metaclass->get_attribute_list >>
This will return a list of attributes I<names> for all attributes
-defined in this class.
+defined in this class. Note that this operates on the current class
+only, it does not traverse the inheritance hierarchy.
=item B<< $metaclass->get_all_attributes >>
projects / gitmo/Class-MOP.git / blobdiff