view release on metacpan or  search on metacpan

inc/Class/MOP/Class.pm  view on Meta::CPAN

sub find_method_by_name {
    my ($self, $method_name) = @_;
    (defined $method_name && length $method_name)
        || confess "You must define a method name to find";
    foreach my $class ($self->linearized_isa) {
        my $method = Class::MOP::Class->initialize($class)->get_method($method_name);
        return $method if defined $method;
    }
    return;
}

sub get_all_methods {
    my $self = shift;

    my %methods;
    for my $class ( reverse $self->linearized_isa ) {
        my $meta = Class::MOP::Class->initialize($class);

        $methods{ $_->name } = $_ for $meta->_get_local_methods;
    }

    return values %methods;
}

sub get_all_method_names {
    my $self = shift;
    my %uniq;
    return grep { !$uniq{$_}++ } map { Class::MOP::Class->initialize($_)->get_method_list } $self->linearized_isa;
}

sub find_all_methods_by_name {
    my ($self, $method_name) = @_;
    (defined $method_name && length $method_name)
        || confess "You must define a method name to find";
    my @methods;
    foreach my $class ($self->linearized_isa) {
        # fetch the meta-class ...
        my $meta = Class::MOP::Class->initialize($class);
        push @methods => {
            name  => $method_name,
            class => $class,
            code  => $meta->get_method($method_name)
        } if $meta->has_method($method_name);
    }
    return @methods;
}

sub find_next_method_by_name {
    my ($self, $method_name) = @_;
    (defined $method_name && length $method_name)
        || confess "You must define a method name to find";
    my @cpl = $self->linearized_isa;
    shift @cpl; # discard ourselves
    foreach my $class (@cpl) {
        my $method = Class::MOP::Class->initialize($class)->get_method($method_name);
        return $method if defined $method;
    }
    return;
}

sub update_meta_instance_dependencies {
    my $self = shift;

    if ( $self->{meta_instance_dependencies} ) {
        return $self->add_meta_instance_dependencies;
    }
}

sub add_meta_instance_dependencies {
    my $self = shift;

    $self->remove_meta_instance_dependencies;

    my @attrs = $self->get_all_attributes();

    my %seen;
    my @classes = grep { not $seen{ $_->name }++ }
        map { $_->associated_class } @attrs;

    foreach my $class (@classes) {
        $class->add_dependent_meta_instance($self);
    }

    $self->{meta_instance_dependencies} = \@classes;
}

sub remove_meta_instance_dependencies {
    my $self = shift;

    if ( my $classes = delete $self->{meta_instance_dependencies} ) {
        foreach my $class (@$classes) {
            $class->remove_dependent_meta_instance($self);
        }

        return $classes;
    }

    return;

}

sub add_dependent_meta_instance {
    my ( $self, $metaclass ) = @_;
    push @{ $self->{dependent_meta_instances} }, $metaclass;
}

sub remove_dependent_meta_instance {
    my ( $self, $metaclass ) = @_;
    my $name = $metaclass->name;
    @$_ = grep { $_->name ne $name } @$_
        for $self->{dependent_meta_instances};
}

sub invalidate_meta_instances {
    my $self = shift;
    $_->invalidate_meta_instance()
        for $self, @{ $self->{dependent_meta_instances} };
}

sub invalidate_meta_instance {
    my $self = shift;