File Coverage

blib/lib/Test/Attribute/AutoLevel.pm

Criterion	Covered	Total	%
statement	44	44	100.0
branch	3	4	75.0
condition	8	8	100.0
subroutine	12	12	100.0
pod			n/a
total	67	68	98.5

package Test::Attribute::AutoLevel;
use strict;
use warnings;
use 5.008001;
our $VERSION = '0.06';

sub import {
    my ($class, %args) = @_;
    my $caller = caller($args{depth} || 0);

    no strict 'refs';
    *{"${caller}::MODIFY_CODE_ATTRIBUTES"} = \&_MODIFY_CODE_ATTRIBUTES;
}

my $stash = {};
sub _fake {
    my ($pkg, $code) = @_;

    $stash->{$pkg} ||= {};
    my $fake = sub {
        local $Test::Builder::Level = $Test::Builder::Level + 2;
        $code->(@_);
    };
    $stash->{$pkg}{"$code"} = $fake;
}

sub _MODIFY_CODE_ATTRIBUTES {
    my ($pkg, $code, @attrs) = @_;
    return unless $attrs[0] eq 'AutoLevel';
    _fake($pkg, $code);
    return;
}

sub CHECK {
    my $pkg = caller;
    return unless exists $stash->{$pkg};

    no strict 'refs';
    for my $name (keys %{"$pkg\::"}) {
        my $code = *{"${pkg}::${name}"}{CODE} || next;
        my $fake = $stash->{$pkg}{"$code"}    || next;
        no warnings 'redefine';
        *{"${pkg}::${name}"} = $fake;
    }

    delete $stash->{$pkg}; # cleanup
}

1;

__END__