File Coverage

inc/Test2/Plugin/INC_Jail.pm

Criterion	Covered	Total	%
statement	31	31	100.0
branch	12	16	75.0
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	49	53	92.4

package Test2::Plugin::INC_Jail;

use 5.008001;

use strict;
use warnings;

use Carp;

our $VERSION = '0.007_01';

sub import {
    my ( undef, $test_class, @test_inc ) = @_;

    my $caller = caller;

    unless ( defined $test_class ) {
	my $code = $caller->can( 'CLASS' )
	    or croak 'No test class specified and caller does not define CLASS';
	$test_class = $code->();
    }

    @test_inc
	or push @test_inc, 't/lib';
    foreach ( @test_inc ) {
	-d
	    or croak "Test module directory $_ not found";
    }

    unshift @INC, sub {

	my $lvl = 0;

	while ( my $pkg = caller $lvl ) {

	    if ( $test_class eq $pkg ) {
		foreach my $dir ( @test_inc ) {
		    my $fh;
		    open $fh, '<', "$dir/$_[1]"
			and return $] ge '5.020' ? ( \'', $fh ) : $fh;
		}
		croak "Can't locate $_[1] in \@INC";
	    }

	    # The reason we have to iterate if the package is our
	    # original caller is that the module under test might be
	    # loading the requested module on behalf of said caller by
	    # doing a stringy eval in the caller's name space.
	    $caller eq $pkg
		or return;

	} continue {
	    $lvl++;
	}
	return;
    };

    return;
}

1;

__END__