File Coverage

blib/lib/Test/Class/Load.pm

Criterion	Covered	Total	%
statement	46	46	100.0
branch	13	14	92.8
condition			n/a
subroutine	9	9	100.0
pod	2	2	100.0
total	70	71	98.5

use strict;
use warnings;

package Test::Class::Load;

use Test::Class;
use File::Find;
use File::Spec;

our $VERSION = '0.49';

# Override to get your own filter
sub is_test_class {
    my ( $class, $file, $dir ) = @_;
    # By default, we only care about .pm files
    if ($file =~ /\.pm$/) {
        return 1;
    }
    return;
}

my %Added_to_INC;
sub _load {
    my ( $class, $file, $dir ) = @_;
    $file =~ s{\.pm$}{};             # remove .pm extension
    $file =~ s{\\}{/}g;              # to make win32 happy
    $dir  =~ s{\\}{/}g;              # to make win32 happy
    $file =~ s/^$dir//;
    my $_package = join '::' => grep $_ => File::Spec->splitdir( $file );

    # untaint that puppy!
    my ( $package ) = $_package =~ /^([[:word:]]+(?:::[[:word:]]+)*)$/;

    # Filter out bad classes (mainly this means things in .svn and similar)
    return unless defined $package;

    unshift @INC => $dir unless $Added_to_INC{ $dir }++;
    eval "require $package"; ## no critic
    die $@ if $@;
}

sub import {
    my ( $class, @directories ) = @_;
    my @test_classes;

    foreach my $dir ( @directories ) {
        $dir = File::Spec->catdir( split '/', $dir );
        find(
            {   no_chdir => 1,
                wanted   => sub {
                    my @args = ($File::Find::name, $dir);
                    if ($class->is_test_class(@args)) {
                        $class->_load(@args);
                    }
                },
            },
            $dir
        );
    }
}

1;

__END__