use Carp 'confess';
use Scalar::Util 'blessed', 'weaken';
+use Sub::Name 'subname';
+use Devel::GlobalDestruction 'in_global_destruction';
-our $VERSION = '0.83';
+our $VERSION = '0.85';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
sub DESTROY {
my $self = shift;
- return if Class::MOP::in_global_destruction(); # it'll happen soon anyway and this just makes things more complicated
+ return if in_global_destruction(); # it'll happen soon anyway and this just makes things more complicated
no warnings 'uninitialized';
return unless $self->name =~ /^$ANON_CLASS_PREFIX/;
# 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. This is hackier, but quicker too.
$self->{methods}{$method_name} = $method;
- my $full_method_name = ($self->name . '::' . $method_name);
+ 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 },
- Class::MOP::subname($full_method_name => $body)
+ { sigil => '&', type => 'CODE', name => $method_name },
+ $body,
);
}
|| confess "You must pass in a method name";
my $method = $fetch_and_prepare_method->($self, $method_name);
$method->add_before_modifier(
- Class::MOP::subname(':before' => $method_modifier)
+ subname(':before' => $method_modifier)
);
}
|| confess "You must pass in a method name";
my $method = $fetch_and_prepare_method->($self, $method_name);
$method->add_after_modifier(
- Class::MOP::subname(':after' => $method_modifier)
+ subname(':after' => $method_modifier)
);
}
|| confess "You must pass in a method name";
my $method = $fetch_and_prepare_method->($self, $method_name);
$method->add_around_modifier(
- Class::MOP::subname(':around' => $method_modifier)
+ subname(':around' => $method_modifier)
);
}
} 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;
# add a method to Foo ...
Foo->meta->add_method( 'bar' => sub {...} )
- # get a list of all the classes searched
- # the method dispatcher in the correct order
- Foo->meta->class_precedence_list()
+ # get a list of all the classes searched
+ # the method dispatcher in the correct order
+ Foo->meta->class_precedence_list()
- # remove a method from Foo
- Foo->meta->remove_method('bar');
+ # remove a method from Foo
+ Foo->meta->remove_method('bar');
# or use this to actually create classes ...
version => '0.01',
superclasses => ['Foo'],
attributes => [
- Class::MOP:: : Attribute->new('$bar'),
- Class::MOP:: : Attribute->new('$baz'),
+ Class::MOP::Attribute->new('$bar'),
+ Class::MOP::Attribute->new('$baz'),
],
methods => {
calculate_bar => sub {...},
=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