use Sub::Name 'subname';
use Devel::GlobalDestruction 'in_global_destruction';
-our $VERSION = '0.83';
+our $VERSION = '0.86';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
# we don't know about
$self->_check_metaclass_compatibility();
- $self->update_meta_instance_dependencies();
+ $self->_superclasses_updated();
}
@{$self->get_package_symbol($var_spec)};
}
+sub _superclasses_updated {
+ my $self = shift;
+ $self->update_meta_instance_dependencies();
+}
+
sub subclasses {
my $self = shift;
my $super_class = $self->name;
return @{ $super_class->mro::get_isarev() };
}
+sub direct_subclasses {
+ my $self = shift;
+ my $super_class = $self->name;
+
+ return grep {
+ grep {
+ $_ eq $super_class
+ } Class::MOP::Class->initialize($_)->superclasses
+ } $self->subclasses;
+}
sub linearized_isa {
return @{ mro::get_linear_isa( (shift)->name ) };
$method->attach_to_class($self);
- # This used to call get_method_map, which meant we would build all
- # the method objects for the class just because we added one
- # method. This is hackier, but quicker too.
- $self->{methods}{$method_name} = $method;
-
- my $full_method_name = ($self->name . '::' . $method_name);
+ $self->get_method_map->{$method_name} = $method;
+
+ my ( $current_package, $current_name ) = Class::MOP::get_code_info($body);
+
+ if ( $current_name eq '__ANON__' ) {
+ my $full_method_name = ($self->name . '::' . $method_name);
+ subname($full_method_name => $body);
+ }
+
$self->add_package_symbol(
- { sigil => '&', type => 'CODE', name => $method_name },
- subname($full_method_name => $body)
+ { sigil => '&', type => 'CODE', name => $method_name },
+ $body,
);
}
(defined $method_name && $method_name)
|| confess "You must define a method name";
- exists $self->{methods}{$method_name} || exists $self->get_method_map->{$method_name};
+ exists $self->get_method_map->{$method_name};
}
sub get_method {
(defined $method_name && $method_name)
|| confess "You must define a method name";
- return $self->{methods}{$method_name} || $self->get_method_map->{$method_name};
+ return $self->get_method_map->{$method_name};
}
sub remove_method {
} else {
$self->invalidate_meta_instances();
}
+
+ # get our count of previously inserted attributes and
+ # increment by one so this attribute knows its order
+ my $order = (scalar keys %{$self->get_attribute_map}) - 1;
+ $attribute->_set_insertion_order($order + 1);
# then onto installing the new accessors
$self->get_attribute_map->{$attribute->name} = $attribute;
my $name = $args{constructor_name};
- #if ( my $existing = $self->name->can($args{constructor_name}) ) {
- # if ( refaddr($existing) == refaddr(\&Moose::Object::new) ) {
-
- unless ( $args{replace_constructor}
- or !$self->has_method($name) ) {
+ if ( $self->has_method($name) && !$args{replace_constructor} ) {
my $class = $self->name;
warn "Not inlining a constructor for $class since it defines"
. " its own constructor.\n"
|| confess "The 'inline_destructor' option is present, but "
. "no destructor class was specified";
+ if ( $self->has_method('DESTROY') ) {
+ my $class = $self->name;
+ warn "Not inlining a destructor for $class since it defines"
+ . " its own destructor.\n";
+ return;
+ }
+
my $destructor_class = $args{destructor_class};
Class::MOP::load_class($destructor_class);
=item B<< $metaclass->subclasses >>
-This returns a list of subclasses for this class.
+This returns a list of all subclasses for this class, even indirect
+subclasses.
+
+=item B<< $metaclass->direct_subclasses >>
+
+This returns a list of immediate subclasses for this class, which does not
+include indirect subclasses.
=back
This will return a L<Class::MOP::Attribute> for the specified
C<$attribute_name>. If the class does not have the specified
-attribute, it returns C<undef>
+attribute, it returns C<undef>.
+
+NOTE that get_attribute does not search superclasses, for
+that you need to use C<find_attribute_by_name>.
=item B<< $metaclass->has_attribute($attribute_name) >>