use Class::MOP::Method::Wrapped;
use Class::MOP::Method::Accessor;
use Class::MOP::Method::Constructor;
+use Class::MOP::MiniTrait;
use Carp 'confess';
use Scalar::Util 'blessed', 'reftype', 'weaken';
use Sub::Name 'subname';
use Devel::GlobalDestruction 'in_global_destruction';
use Try::Tiny;
+use List::MoreUtils 'all';
-our $VERSION = '1.00';
+our $VERSION = '1.09';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
-use base 'Class::MOP::Module', 'Class::MOP::Mixin::HasAttributes';
+use base 'Class::MOP::Module',
+ 'Class::MOP::Mixin::HasAttributes',
+ 'Class::MOP::Mixin::HasMethods';
# Creation
|| $class->_construct_class_instance(package => $package_name, @_);
}
+sub reinitialize {
+ my ( $class, @args ) = @_;
+ unshift @args, "package" if @args % 2;
+ my %options = @args;
+ my $old_metaclass = blessed($options{package})
+ ? $options{package}
+ : Class::MOP::get_metaclass_by_name($options{package});
+ $old_metaclass->_remove_generated_metaobjects
+ if $old_metaclass && $old_metaclass->isa('Class::MOP::Class');
+ my $new_metaclass = $class->SUPER::reinitialize(@args);
+ $new_metaclass->_restore_metaobjects_from($old_metaclass)
+ if $old_metaclass && $old_metaclass->isa('Class::MOP::Class');
+ return $new_metaclass;
+}
+
# NOTE: (meta-circularity)
# this is a special form of _construct_instance
# (see below), which is used to construct class
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;
$self->{'_package_cache_flag'} = Class::MOP::check_package_cache_flag($self->name);
}
+## Metaclass compatibility
+{
+ my %base_metaclass = (
+ attribute_metaclass => 'Class::MOP::Attribute',
+ method_metaclass => 'Class::MOP::Method',
+ wrapped_method_metaclass => 'Class::MOP::Method::Wrapped',
+ instance_metaclass => 'Class::MOP::Instance',
+ constructor_class => 'Class::MOP::Method::Constructor',
+ destructor_class => 'Class::MOP::Method::Destructor',
+ );
+
+ sub _base_metaclasses { %base_metaclass }
+}
+
sub _check_metaclass_compatibility {
my $self = shift;
+ my @superclasses = $self->superclasses
+ or return;
+
+ $self->_fix_metaclass_incompatibility(@superclasses);
+
+ my %base_metaclass = $self->_base_metaclasses;
+
# this is always okay ...
- return if ref($self) eq 'Class::MOP::Class' &&
- $self->instance_metaclass eq 'Class::MOP::Instance';
+ return
+ if ref($self) eq 'Class::MOP::Class'
+ && all {
+ my $meta = $self->$_;
+ !defined($meta) || $meta eq $base_metaclass{$_};
+ }
+ keys %base_metaclass;
- my @class_list = $self->linearized_isa;
- shift @class_list; # shift off $self->name
+ for my $superclass (@superclasses) {
+ $self->_check_class_metaclass_compatibility($superclass);
+ }
- foreach my $superclass_name (@class_list) {
- my $super_meta = Class::MOP::get_metaclass_by_name($superclass_name) || next;
+ 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 );
+ }
+ }
+}
- # 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);
-
- ($self->isa($super_meta_type))
- || confess "The metaclass of " . $self->name . " ("
- . (ref($self)) . ")" . " is not compatible with the " .
- "metaclass of its superclass, ".$superclass_name . " ("
- . ($super_meta_type) . ")";
- # NOTE:
- # we also need to check that instance metaclasses
- # are compatibile in the same the class.
- ($self->instance_metaclass->isa($super_meta->instance_metaclass))
- || confess "The instance metaclass for " . $self->name . " (" . ($self->instance_metaclass) . ")" .
- " is not compatible with the " .
- "instance metaclass of its superclass, " . $superclass_name . " (" . ($super_meta->instance_metaclass) . ")";
+sub _check_class_metaclass_compatibility {
+ my $self = shift;
+ my ( $superclass_name ) = @_;
+
+ if (!$self->_class_metaclass_is_compatible($superclass_name)) {
+ my $super_meta = Class::MOP::get_metaclass_by_name($superclass_name);
+
+ my $super_meta_type = $super_meta->_real_ref_name;
+
+ confess "The metaclass of " . $self->name . " ("
+ . (ref($self)) . ")" . " is not compatible with "
+ . "the metaclass of its superclass, "
+ . $superclass_name . " (" . ($super_meta_type) . ")";
+ }
+}
+
+sub _class_metaclass_is_compatible {
+ my $self = shift;
+ my ( $superclass_name ) = @_;
+
+ my $super_meta = Class::MOP::get_metaclass_by_name($superclass_name)
+ || return 1;
+
+ my $super_meta_type = $super_meta->_real_ref_name;
+
+ return $self->isa($super_meta_type);
+}
+
+sub _check_single_metaclass_compatibility {
+ my $self = shift;
+ my ( $metaclass_type, $superclass_name ) = @_;
+
+ if (!$self->_single_metaclass_is_compatible($metaclass_type, $superclass_name)) {
+ my $super_meta = Class::MOP::get_metaclass_by_name($superclass_name);
+ my $metaclass_type_name = $metaclass_type;
+ $metaclass_type_name =~ s/_(?:meta)?class$//;
+ $metaclass_type_name =~ s/_/ /g;
+ confess "The $metaclass_type_name metaclass for "
+ . $self->name . " (" . ($self->$metaclass_type)
+ . ")" . " is not compatible with the "
+ . "$metaclass_type_name metaclass of its "
+ . "superclass, $superclass_name ("
+ . ($super_meta->$metaclass_type) . ")";
}
}
+sub _single_metaclass_is_compatible {
+ my $self = shift;
+ my ( $metaclass_type, $superclass_name ) = @_;
+
+ my $super_meta = Class::MOP::get_metaclass_by_name($superclass_name)
+ || return 1;
+
+ # for instance, Moose::Meta::Class has a error_class attribute, but
+ # Class::MOP::Class doesn't - this shouldn't be an error
+ 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 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);
+}
+
+sub _fix_metaclass_incompatibility {
+ my $self = shift;
+ my @supers = map { Class::MOP::Class->initialize($_) } @_;
+
+ my $necessary = 0;
+ for my $super (@supers) {
+ $necessary = 1
+ if $self->_can_fix_metaclass_incompatibility($super);
+ }
+ return unless $necessary;
+
+ 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) {
+ for my $super (@supers) {
+ if (!$self->_single_metaclass_is_compatible($metaclass_type, $super->name)) {
+ $self->_fix_single_metaclass_incompatibility(
+ $metaclass_type, $super
+ );
+ }
+ }
+ }
+}
+
+sub _can_fix_metaclass_incompatibility {
+ my $self = shift;
+ return $self->_can_fix_metaclass_incompatibility_by_subclassing(@_);
+}
+
+sub _can_fix_metaclass_incompatibility_by_subclassing {
+ my $self = shift;
+ my ($super_meta) = @_;
+
+ return 1 if $self->_can_fix_class_metaclass_incompatibility_by_subclassing($super_meta);
+
+ my %base_metaclass = $self->_base_metaclasses;
+ for my $metaclass_type (keys %base_metaclass) {
+ return 1 if $self->_can_fix_single_metaclass_incompatibility_by_subclassing($metaclass_type, $super_meta);
+ }
+
+ return;
+}
+
+sub _can_fix_class_metaclass_incompatibility_by_subclassing {
+ my $self = shift;
+ my ($super_meta) = @_;
+
+ my $super_meta_type = $super_meta->_real_ref_name;
+
+ return $super_meta_type ne blessed($self)
+ && $super_meta->isa(blessed($self));
+}
+
+sub _can_fix_single_metaclass_incompatibility_by_subclassing {
+ my $self = shift;
+ my ($metaclass_type, $super_meta) = @_;
+
+ my $specific_meta = $self->$metaclass_type;
+ return unless $super_meta->can($metaclass_type);
+ my $super_specific_meta = $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 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);
+}
+
+sub _fix_class_metaclass_incompatibility {
+ my $self = shift;
+ my ( $super_meta ) = @_;
+
+ if ($self->_can_fix_class_metaclass_incompatibility_by_subclassing($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);
+ }
+}
+
+sub _fix_single_metaclass_incompatibility {
+ my $self = shift;
+ 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;
+ }
+}
+
+sub _restore_metaobjects_from {
+ my $self = shift;
+ my ($old_meta) = @_;
+
+ for my $method ($old_meta->_get_local_methods) {
+ $self->_make_metaobject_compatible($method);
+ $self->add_method($method->name => $method);
+ }
+
+ for my $attr (sort { $a->insertion_order <=> $b->insertion_order }
+ map { $old_meta->get_attribute($_) }
+ $old_meta->get_attribute_list) {
+ $self->_make_metaobject_compatible($attr);
+ $self->add_attribute($attr);
+ }
+}
+
+sub _remove_generated_metaobjects {
+ my $self = shift;
+
+ for my $attr (map { $self->get_attribute($_) } $self->get_attribute_list) {
+ $attr->remove_accessors;
+ }
+}
+
+sub _make_metaobject_compatible {
+ my $self = shift;
+ my ($object) = @_;
+
+ my $new_metaclass = $self->_get_compatible_single_metaclass(blessed($object));
+
+ if (!defined($new_metaclass)) {
+ confess "Can't make $object compatible with metaclass "
+ . $self->_get_associated_single_metaclass(blessed($object));
+ }
+
+ # can't use rebless_instance here, because it might not be an actual
+ # subclass in the case of, e.g. moose role reconciliation
+ $new_metaclass->meta->_force_rebless_instance($object)
+ if blessed($object) ne $new_metaclass;
+
+ return $object;
+}
+
+sub _get_associated_single_metaclass {
+ my $self = shift;
+ my ($single_meta_name) = @_;
+
+ my $current_single_meta_name;
+ if ($single_meta_name->isa('Class::MOP::Method')) {
+ $current_single_meta_name = $self->method_metaclass;
+ }
+ elsif ($single_meta_name->isa('Class::MOP::Attribute')) {
+ $current_single_meta_name = $self->attribute_metaclass;
+ }
+ else {
+ confess "Can't make $single_meta_name compatible, it isn't an "
+ . "attribute or method metaclass.";
+ }
+
+ return $current_single_meta_name;
+}
+
+sub _get_compatible_single_metaclass {
+ my $self = shift;
+ my ($single_meta_name) = @_;
+
+ return $self->_get_compatible_single_metaclass_by_subclassing($single_meta_name);
+}
+
+sub _get_compatible_single_metaclass_by_subclassing {
+ my $self = shift;
+ my ($single_meta_name) = @_;
+
+ my $current_single_meta_name = $self->_get_associated_single_metaclass($single_meta_name);
+
+ if ($single_meta_name->isa($current_single_meta_name)) {
+ return $single_meta_name;
+ }
+ elsif ($current_single_meta_name->isa($single_meta_name)) {
+ return $current_single_meta_name;
+ }
+
+ return;
+}
+
## ANON classes
{
superclasses
attributes
methods
+ no_meta
version
authority
)};
# 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]);
- });
+ }) unless $options{no_meta};
$meta->superclasses(@{$options{superclasses}})
if exists $options{superclasses};
# the code below is almost certainly incorrect
# but this is foreign inheritance, so we might
# have to kludge it in the end.
- my $instance = $params->{__INSTANCE__} || $meta_instance->create_instance();
+ my $instance;
+ if (my $instance_class = blessed($params->{__INSTANCE__})) {
+ ($instance_class eq $class->name)
+ || confess "Objects passed as the __INSTANCE__ parameter must "
+ . "already be blessed into the correct class, but "
+ . "$params->{__INSTANCE__} is not a " . $class->name;
+ $instance = $params->{__INSTANCE__};
+ }
+ elsif (exists $params->{__INSTANCE__}) {
+ confess "The __INSTANCE__ parameter must be a blessed reference, not "
+ . $params->{__INSTANCE__};
+ }
+ else {
+ $instance = $meta_instance->create_instance();
+ }
foreach my $attr ($class->get_all_attributes()) {
$attr->initialize_instance_slot($meta_instance, $instance, $params);
}
return $instance;
}
+sub inline_create_instance {
+ my $self = shift;
+
+ return $self->get_meta_instance->inline_create_instance(@_);
+}
+
+sub inline_rebless_instance {
+ my $self = shift;
+
+ return $self->get_meta_instance->inline_rebless_instance_structure(@_);
+}
+
sub clone_object {
my $class = shift;
my $instance = shift;
return $clone;
}
-sub rebless_instance {
+sub _force_rebless_instance {
my ($self, $instance, %params) = @_;
-
my $old_metaclass = Class::MOP::class_of($instance);
- my $old_class = $old_metaclass ? $old_metaclass->name : blessed($instance);
- $self->name->isa($old_class)
- || confess "You may rebless only into a subclass of ($old_class), of which (". $self->name .") isn't.";
-
$old_metaclass->rebless_instance_away($instance, $self, %params)
if $old_metaclass;
- my $meta_instance = $self->get_meta_instance();
+ my $meta_instance = $self->get_meta_instance;
# rebless!
# we use $_[1] here because of t/306_rebless_overload.t regressions on 5.8.8
$meta_instance->rebless_instance_structure($_[1], $self);
- foreach my $attr ( $self->get_all_attributes ) {
- if ( $attr->has_value($instance) ) {
- if ( defined( my $init_arg = $attr->init_arg ) ) {
- $params{$init_arg} = $attr->get_value($instance)
- unless exists $params{$init_arg};
- }
- else {
- $attr->set_value($instance, $attr->get_value($instance));
- }
- }
- }
+ $self->_fixup_attributes_after_rebless($instance, $old_metaclass, %params);
+}
- foreach my $attr ($self->get_all_attributes) {
- $attr->initialize_instance_slot($meta_instance, $instance, \%params);
- }
-
- $instance;
+sub rebless_instance {
+ my ($self, $instance, %params) = @_;
+ my $old_metaclass = Class::MOP::class_of($instance);
+
+ my $old_class = $old_metaclass ? $old_metaclass->name : blessed($instance);
+ $self->name->isa($old_class)
+ || confess "You may rebless only into a subclass of ($old_class), of which (". $self->name .") isn't.";
+
+ $self->_force_rebless_instance($_[1], %params);
+
+ return $instance;
}
sub rebless_instance_back {
my ( $self, $instance ) = @_;
-
my $old_metaclass = Class::MOP::class_of($instance);
my $old_class
. $self->name
. ") isn't.";
- $old_metaclass->rebless_instance_away( $instance, $self )
- if $old_metaclass;
+ $self->_force_rebless_instance($_[1]);
- my $meta_instance = $self->get_meta_instance;
+ return $instance;
+}
- # we use $_[1] here because of t/306_rebless_overload.t regressions on 5.8.8
- $meta_instance->rebless_instance_structure( $_[1], $self );
+sub rebless_instance_away {
+ # this intentionally does nothing, it is just a hook
+}
+
+sub _fixup_attributes_after_rebless {
+ my $self = shift;
+ my ($instance, $rebless_from, %params) = @_;
+ my $meta_instance = $self->get_meta_instance;
- for my $attr ( $old_metaclass->get_all_attributes ) {
- next if $self->has_attribute( $attr->name );
+ for my $attr ( $rebless_from->get_all_attributes ) {
+ next if $self->find_attribute_by_name( $attr->name );
$meta_instance->deinitialize_slot( $instance, $_ ) for $attr->slots;
}
- return $instance;
-}
+ foreach my $attr ( $self->get_all_attributes ) {
+ if ( $attr->has_value($instance) ) {
+ if ( defined( my $init_arg = $attr->init_arg ) ) {
+ $params{$init_arg} = $attr->get_value($instance)
+ unless exists $params{$init_arg};
+ }
+ else {
+ $attr->set_value($instance, $attr->get_value($instance));
+ }
+ }
+ }
-sub rebless_instance_away {
- # this intentionally does nothing, it is just a hook
+ foreach my $attr ($self->get_all_attributes) {
+ $attr->initialize_instance_slot($meta_instance, $instance, \%params);
+ }
}
sub _attach_attribute {
foreach my $class ( $self->linearized_isa ) {
# fetch the meta-class ...
- my $meta = $self->initialize($class);
+ my $meta = Class::MOP::Class->initialize($class);
return $meta->get_attribute($attr_name)
if $meta->has_attribute($attr_name);
}
sub get_all_attributes {
my $self = shift;
- my %attrs = map { %{ $self->initialize($_)->_attribute_map } }
+ my %attrs = map { %{ Class::MOP::Class->initialize($_)->_attribute_map } }
reverse $self->linearized_isa;
return values %attrs;
}
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 {
return (
$name,
map {
- $self->initialize($_)->class_precedence_list()
+ Class::MOP::Class->initialize($_)->class_precedence_list()
} $self->superclasses()
);
}
(defined $method_name && length $method_name)
|| confess "You must define a method name to find";
foreach my $class ($self->linearized_isa) {
- my $method = $self->initialize($class)->get_method($method_name);
+ my $method = Class::MOP::Class->initialize($class)->get_method($method_name);
return $method if defined $method;
}
return;
my %methods;
for my $class ( reverse $self->linearized_isa ) {
- my $meta = $self->initialize($class);
+ 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;
sub get_all_method_names {
my $self = shift;
my %uniq;
- return grep { !$uniq{$_}++ } map { $self->initialize($_)->get_method_list } $self->linearized_isa;
+ return grep { !$uniq{$_}++ } map { Class::MOP::Class->initialize($_)->get_method_list } $self->linearized_isa;
}
sub find_all_methods_by_name {
my @methods;
foreach my $class ($self->linearized_isa) {
# fetch the meta-class ...
- my $meta = $self->initialize($class);
+ my $meta = Class::MOP::Class->initialize($class);
push @methods => {
name => $method_name,
class => $class,
my @cpl = $self->linearized_isa;
shift @cpl; # discard ourselves
foreach my $class (@cpl) {
- my $method = $self->initialize($class)->get_method($method_name);
+ my $method = Class::MOP::Class->initialize($class)->get_method($method_name);
return $method if defined $method;
}
return;
# 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,
superclasses => [ ref $self ],
);
- Class::MOP::load_class($trait);
- for my $meth ( Class::MOP::Class->initialize($trait)->get_all_methods ) {
- my $meth_name = $meth->name;
-
- if ( $immutable_meta->find_method_by_name( $meth_name ) ) {
- $immutable_meta->add_around_method_modifier( $meth_name, $meth->body );
- }
- else {
- $immutable_meta->add_method( $meth_name, $meth->clone );
- }
- }
+ Class::MOP::MiniTrait::apply( $immutable_meta, $trait );
$immutable_meta->make_immutable(
inline_constructor => 0,
An optional array reference of L<Class::MOP::Attribute> objects.
+=item * no_meta
+
+If true, a C<meta> method will not be installed into the class.
+
=back
=item B<< Class::MOP::Class->create_anon_class(%options) >>
Returns an instance of the C<instance_metaclass> to be used in the
construction of a new instance of the class.
+=item B<< $metaclass->inline_create_instance($class_var) >>
+
+=item B<< $metaclass->inline_rebless_instance($instance_var, $class_var) >>
+
+These methods takes variable names, and use them to create an inline snippet
+of code that will create a new instance of the class.
+
=back
=head2 Informational predicates
=back
-=head2 Method introspection
+=head2 Method introspection and creation
+
+These methods allow you to introspect a class's methods, as well as
+add, remove, or change methods.
+
+Determining what is truly a method in a Perl 5 class requires some
+heuristics (aka guessing).
+
+Methods defined outside the package with a fully qualified name (C<sub
+Package::name { ... }>) will be included. Similarly, methods named
+with a fully qualified name using L<Sub::Name> are also included.
-See L<Class::MOP::Package/Method introspection and creation> for
-methods that operate only on the current class. Class::MOP::Class adds
-introspection capabilities that take inheritance into account.
+However, we attempt to ignore imported functions.
+
+Ultimately, we are using heuristics to determine what truly is a
+method in a class, and these heuristics may get the wrong answer in
+some edge cases. However, for most "normal" cases the heuristics work
+correctly.
=over 4
+=item B<< $metaclass->get_method($method_name) >>
+
+This will return a L<Class::MOP::Method> for the specified
+C<$method_name>. If the class does not have the specified method, it
+returns C<undef>
+
+=item B<< $metaclass->has_method($method_name) >>
+
+Returns a boolean indicating whether or not the class defines the
+named method. It does not include methods inherited from parent
+classes.
+
+=item B<< $metaclass->get_method_list >>
+
+This will return a list of method I<names> for all methods defined in
+this class.
+
+=item B<< $metaclass->add_method($method_name, $method) >>
+
+This method takes a method name and a subroutine reference, and adds
+the method to the class.
+
+The subroutine reference can be a L<Class::MOP::Method>, and you are
+strongly encouraged to pass a meta method object instead of a code
+reference. If you do so, that object gets stored as part of the
+class's method map directly. If not, the meta information will have to
+be recreated later, and may be incorrect.
+
+If you provide a method object, this method will clone that object if
+the object's package name does not match the class name. This lets us
+track the original source of any methods added from other classes
+(notably Moose roles).
+
+=item B<< $metaclass->remove_method($method_name) >>
+
+Remove the named method from the class. This method returns the
+L<Class::MOP::Method> object for the method.
+
+=item B<< $metaclass->method_metaclass >>
+
+Returns the class name of the method metaclass, see
+L<Class::MOP::Method> for more information on the method metaclass.
+
+=item B<< $metaclass->wrapped_method_metaclass >>
+
+Returns the class name of the wrapped method metaclass, see
+L<Class::MOP::Method::Wrapped> for more information on the wrapped
+method metaclass.
+
=item B<< $metaclass->get_all_methods >>
This will traverse the inheritance hierarchy and return a list of all
=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