File Coverage

blib/lib/MouseX/Foreign/Meta/Role/Class.pm

Criterion	Covered	Total	%
statement	23	23	100.0
branch	6	8	75.0
condition			n/a
subroutine	4	4	100.0
pod	0	1	0.0
total	33	36	91.6

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__