File Coverage

blib/lib/Test/Roo/DataDriven.pm
Criterion Covered Total %
statement 66 70 94.2
branch 18 24 75.0
condition 14 24 58.3
subroutine 11 12 91.6
pod 2 2 100.0
total 111 132 84.0


line stmt bran cond sub pod time code
1             package Test::Roo::DataDriven;
2              
3             # ABSTRACT: simple data-driven tests with Test::Roo
4              
5             # RECOMMEND PREREQ: App::Prove
6             # RECOMMEND PREREQ: Ref::Util::XS
7              
8 6     6   87273 use v5.8;
  6         19  
9              
10 6     6   360 use Test::Roo::Role;
  6         423  
  6         29  
11              
12 6     6   7931 use curry;
  6         1568  
  6         161  
13              
14 6     6   2185 use Class::Unload;
  6         4847  
  6         150  
15 6     6   3430 use Path::Tiny;
  6         48217  
  6         304  
16 6     6   2629 use Ref::Util qw/ is_arrayref is_hashref /;
  6         8153  
  6         348  
17              
18 6     6   2693 use namespace::autoclean;
  6         65868  
  6         55  
19              
20             requires 'run_tests';
21              
22             our $VERSION = 'v0.4.0';
23              
24              
25             sub _build_data_files {
26 5     5   12 my ( $class, $args ) = @_;
27              
28 5   66     61 my $match = $args->{match} || qr/\.dat$/;
29              
30 5         13 my @paths;
31             my @files;
32              
33 5 100       15 my $argv = defined $args->{argv} ? $args->{argv} : 1;
34 5 100 100     89 if ( $argv && @ARGV ) {
35 1         3 @paths = map { path($_) } @ARGV;
  1         14  
36             }
37             else {
38             @paths =
39 4         17 map { path($_) } is_arrayref( $args->{files} )
40 4         72 ? @{ $args->{files} }
41 4 50       15 : ( $args->{files} );
42             }
43              
44 5         197 foreach my $path (@paths) {
45              
46 5 50       23 die "Path $path does not exist" unless $path->exists;
47              
48 5 100       267 if ( $path->is_dir ) {
49              
50             my $iter = $path->iterator(
51             {
52             recurse => $args->{recurse} || 0,
53 4   50     114 follow_symlinks => $args->{follow_symlinks} || 0,
      50        
54             }
55             );
56              
57 4         121 while ( my $file = $iter->() ) {
58 33 100       3711 next unless $file->basename =~ $match;
59 12         392 push @files, $file;
60             }
61              
62             }
63             else {
64              
65 1         16 push @files, $path;
66              
67             }
68              
69             }
70              
71 5         245 return [ sort @files ];
72             }
73              
74              
75             sub run_data_tests {
76 5     5 1 20702 my ( $class, @args ) = @_;
77              
78             my %args =
79             ( ( @args == 1 ) && is_hashref( $args[0] ) )
80 5 50 33     34 ? %{ $args[0] }
  0         0  
81             : @args;
82              
83 5   50 0   21 my $filter = $args{filter} || sub { $_[0] };
  0         0  
84 5   66     62 my $parser = $args{parser} || $class->curry::parse_data_file;
85              
86 5         72 foreach my $file ( @{ $class->_build_data_files( \%args ) } ) {
  5         17  
87              
88 13         71150 note "Data: $file";
89              
90 13         4809 my $data = $parser->($file);
91              
92 13 100       3204 if ( is_arrayref($data) ) {
    50          
93              
94 4         17 my @cases = @$data;
95 4         16 my $i = 0;
96              
97 4         11 foreach my $case (@cases) {
98              
99             my $desc = sprintf(
100             '%s (%u of %u)',
101 14   33     80924 $case->{description} || $file->basename, #
102             ++$i, #
103             scalar(@cases) #
104             );
105              
106 14         228 $class->run_tests( $desc, $filter->( $case, $file, $i ) );
107              
108             }
109              
110             }
111             elsif ( is_hashref($data) ) {
112              
113 9   66     40 my $desc = $data->{description} || $file->basename;
114              
115 9         78 $class->run_tests( $desc, $filter->( $data, $file ) );
116             }
117             else {
118              
119 0         0 my $type = ref $data;
120 0         0 die "unsupported data type ${type} returned by ${file}";
121              
122             }
123              
124             }
125              
126             }
127              
128              
129             my $Counter = 0;
130              
131             sub parse_data_file {
132 13     13 1 5918 my ( $class, $file ) = @_;
133              
134 13         55 my $path = $file->absolute;
135              
136 13     13   935 my $eval = sub { eval $_[0] }; ## no critic (ProhibitStringyEval)
  13         1101  
137              
138 13         39 my $package = __PACKAGE__ . "::Sandbox" . $Counter++;
139              
140 13         50 my $data = $eval->("package ${package}; do q{${path}} or die \$!;");
141              
142 13 100       30103 die "parse failed on $file: $@" if $@;
143 10 50       31 die "do failed on $file: $!" unless defined $data;
144 10 50       22 die "run failed or no data returned on $file" unless $data;
145              
146 10         72 Class::Unload->unload($package);
147              
148 10         1220 return $data;
149             }
150              
151              
152             1;
153              
154             __END__