view release on metacpan or  search on metacpan

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

    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;
    undef $self->{_meta_instance};
}

# check if we can reinitialize
sub is_pristine {
    my $self = shift;

    # if any local attr is defined
    return if $self->get_attribute_list;

    # or any non-declared methods
    for my $method ( map { $self->get_method($_) } $self->get_method_list ) {
        return if $method->isa("Class::MOP::Method::Generated");
        # FIXME do we need to enforce this too? return unless $method->isa( $self->method_metaclass );
    }

    return 1;
}

## Class closing

sub is_mutable   { 1 }
sub is_immutable { 0 }

sub immutable_options { %{ $_[0]{__immutable}{options} || {} } }

sub _immutable_options {
    my ( $self, @args ) = @_;

    return (
        inline_accessors   => 1,
        inline_constructor => 1,
        inline_destructor  => 0,
        debug              => 0,
        immutable_trait    => $self->immutable_trait,
        constructor_name   => $self->constructor_name,
        constructor_class  => $self->constructor_class,
        destructor_class   => $self->destructor_class,
        @args,
    );
}

sub make_immutable {
    my ( $self, @args ) = @_;

    return unless $self->is_mutable;

    my ($file, $line) = (caller)[1..2];

    $self->_initialize_immutable(
        file => $file,
        line => $line,
        $self->_immutable_options(@args),
    );
    $self->_rebless_as_immutable(@args);

    return $self;
}

sub make_mutable {
    my $self = shift;

    if ( $self->is_immutable ) {
        my @args = $self->immutable_options;
        $self->_rebless_as_mutable();
        $self->_remove_inlined_code(@args);
        delete $self->{__immutable};
        return $self;
    }
    else {
        return;
    }
}

sub _rebless_as_immutable {
    my ( $self, @args ) = @_;

    $self->{__immutable}{original_class} = ref $self;

    bless $self => $self->_immutable_metaclass(@args);
}

sub _immutable_metaclass {
    my ( $self, %args ) = @_;

    if ( my $class = $args{immutable_metaclass} ) {
        return $class;
    }

    my $trait = $args{immutable_trait} = $self->immutable_trait
        || confess "no immutable trait specified for $self";

    my $meta      = $self->meta;
    my $meta_attr = $meta->find_attribute_by_name("immutable_trait");

    my $class_name;

    if ( $meta_attr and $trait eq $meta_attr->default ) {
        # if the trait is the same as the default we try and pick a
        # predictable name for the immutable metaclass
        $class_name = 'Class::MOP::Class::Immutable::' . ref($self);
    }
    else {
        $class_name = join '::', 'Class::MOP::Class::Immutable::CustomTrait',
            $trait, 'ForMetaClass', ref($self);
    }

    return $class_name