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


line stmt bran cond sub pod time code
1 4     4   50419 use strict;
  4         9  
  4         143  
  6         2001  
  6         186  
  6         375  
2 4     4   20 use warnings;
  4         6  
  4         166  
  3         27  
  3         167  
  10         17  
3              
4             package Test::Class::Load;
5              
6 4     4   1541 use Test::Class;
  4         7  
  4         103  
  10         22  
  4         12  
7 4     4   19 use File::Find;
  4         3  
  4         233  
8 4     4   17 use File::Spec;
  4         5  
  4         1116  
9              
10             our $VERSION = '0.49';
11              
12             # Override to get your own filter
13             sub is_test_class {
14 5     5 1 6 my ( $class, $file, $dir ) = @_;
          1    
15             # By default, we only care about .pm files
16 5 100       17 if ($file =~ /\.pm$/) {
    100          
17 2         6 return 1;
18             }
19 3         226 return;
20             }
21              
22             my %Added_to_INC;
23             sub _load {
24 15     15   15 my ( $class, $file, $dir ) = @_;
25 15         42 $file =~ s{\.pm$}{}; # remove .pm extension
26 9         13 $file =~ s{\\}{/}g; # to make win32 happy
27 11         312 $dir =~ s{\\}{/}g; # to make win32 happy
28 5         32 $file =~ s/^$dir//;
29 5         44 my $_package = join '::' => grep $_ => File::Spec->splitdir( $file );
30              
31             # untaint that puppy!
32 5         25 my ( $package ) = $_package =~ /^([[:word:]]+(?:::[[:word:]]+)*)$/;
33            
34             # Filter out bad classes (mainly this means things in .svn and similar)
35 5 100       11 return unless defined $package;
    100          
36              
37 5 100       18 unshift @INC => $dir unless $Added_to_INC{ $dir }++;
38 5         258 eval "require $package"; ## no critic
39 5 50       1998 die $@ if $@;
40             }
41              
42             sub import {
43 7     7   58 my ( $class, @directories ) = @_;
44 7         15 my @test_classes;
45              
46 7         21 foreach my $dir ( @directories ) {
47 6         28 $dir = File::Spec->catdir( split '/', $dir );
48             find(
49             { no_chdir => 1,
50             wanted => sub {
51 17     20   320 my @args = ($File::Find::name, $dir);
52 17 100       50 if ($class->is_test_class(@args)) {
53 9         33 $class->_load(@args);
54             }
55             },
56             },
57 6         244 $dir
58             );
59             }
60             }
61              
62             1;
63              
64             __END__