Beta Shell v2.0

File Manager

~ /usr/share/perl5/vendor_perl/MouseX/Foreign/Meta/Role

Name	Size	Perms	Modified	Actions
[ .. / .. ]
Class.pm	1.79 KB	-rw-r--r--	2019-10-23 07:09:11	Edit Del
Method	-	drwxr-xr-x	2022-02-23 11:31:15	Del

Editing: Class.pm (1.79 KB)

package MouseX::Foreign::Meta::Role::Class;
use Mouse::Role;
use Mouse::Util::MetaRole;

__PACKAGE__->meta->add_metaclass_accessor('foreign_superclass');

after superclasses => sub {
    my($self, @args) = @_;
    if(@args && !$self->name->isa('Mouse::Object')) {
        push @{$self->{superclasses}}, 'Mouse::Object';
    }
    return;
};

before verify_superclass => sub {
    my($self, $super, $super_meta) = @_;

    if(defined($super_meta) && $super_meta->does(__PACKAGE__)) {
        $self->inherit_from_foreign_class($super);
    }
    return;
};

sub inherit_from_foreign_class { # override
    my($self, $super) = @_;
    if(defined $self->foreign_superclass) {
        $self->throw_error(
            "Multiple inheritance"
            . " from foreign classes ($super, "
            . $self->foreign_superclass
            . ") is forbidden");
    }
    my %traits;
    if($super->can('new')) {
        $traits{constructor} = ['MouseX::Foreign::Meta::Role::Method::Constructor'];
    }
    if($super->can('DESTROY')) {
        $traits{destructor}  = ['MouseX::Foreign::Meta::Role::Method::Destructor'];
    }
    if(%traits) {
        $self->foreign_superclass($super);
        $_[0] = $self = Mouse::Util::MetaRole::apply_metaroles(
            for             => $self,
            class_metaroles => \%traits,
        );

        # FIXME
        $self->add_method(
            new => $self->constructor_class->_generate_constructor($self),
        );
        $self->add_method(
            DESTROY => $self->destructor_class->_generate_destructor($self),
        );
    }
    return;
}

no Mouse::Role;
1;
__END__

=head1 NAME

MouseX::Foreign::Meta::Role::Class - The MouseX::Foreign meta class role

=head1 DESCRIPTION

This is the meta class role for MouseX::Foreign.

=head1 SEE ALSO

L<MouseX::Foreign>

=cut