File Coverage

blib/lib/Mite/Trait/HasDestructor.pm

Criterion	Covered	Total	%
statement	13	13	100.0
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	18	100.0

use 5.010001;
use strict;
use warnings;

package Mite::Trait::HasDestructor;
use Mite::Miteception -role, -all;

our $AUTHORITY = 'cpan:TOBYINK';
our $VERSION   = '0.012000';

requires qw(
    linear_isa
    _get_parent
    _compile_meta
);

around compilation_stages => sub {
    my ( $next, $self ) = ( shift, shift );

    # Check if we are inheriting from a Mite class in this project
    my $inherit_from_mite = do {
        # First parent
        my $first_isa = do {
            my @isa = $self->linear_isa;
            shift @isa;
            shift @isa;
        };
        !! ( $first_isa and $self->_get_parent( $first_isa ) );
    };

    my @stages = $self->$next( @_ );

    # Only need these stages if not already inheriting from Mite
    push @stages, qw(
        _compile_destroy
    ) unless $inherit_from_mite;

    return @stages;
};

sub _compile_destroy {
    my $self = shift;
    sprintf <<'CODE', $self->_compile_meta( '$class', '$self' );
# Destructor should call DEMOLISH methods
sub DESTROY {
    my $self  = shift;
    my $class = ref( $self ) || $self;
    my $meta  = %s;
    my $in_global_destruction = defined ${^GLOBAL_PHASE}
        ? ${^GLOBAL_PHASE} eq 'DESTRUCT'
        : Devel::GlobalDestruction::in_global_destruction();
    for my $demolisher ( @{ $meta->{DEMOLISH} || [] } ) {
        my $e = do {
            local ( $?, $@ );
            eval { $demolisher->( $self, $in_global_destruction ) };
            $@;
        };
        no warnings 'misc'; # avoid (in cleanup) warnings
        die $e if $e;       # rethrow
    }
    return;
}
CODE
}

1;