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   89898 use v5.8;
  6         19  
9              
10 6     6   425 use Test::Roo::Role;
  6         511  
  6         34  
11              
12 6     6   8882 use curry;
  6         1685  
  6         169  
13              
14 6     6   2186 use Class::Unload;
  6         5689  
  6         160  
15 6     6   3312 use Path::Tiny;
  6         48284  
  6         703  
16 6     6   2791 use Ref::Util qw/ is_arrayref is_hashref /;
  6         8753  
  6         438  
17              
18 6     6   2349 use namespace::autoclean;
  6         70772  
  6         33  
19              
20             requires 'run_tests';
21              
22             our $VERSION = 'v0.4.2';
23              
24              
25             sub _build_data_files {
26 5     5   21 my ( $class, $args ) = @_;
27              
28 5   66     70 my $match = $args->{match} || qr/\.dat$/;
29              
30 5         13 my @paths;
31             my @files;
32              
33 5 100       24 my $argv = defined $args->{argv} ? $args->{argv} : 1;
34 5 100 100     79 if ( $argv && @ARGV ) {
35 1         3 @paths = map { path($_) } @ARGV;
  1         17  
36             }
37             else {
38             @paths =
39 4         29 map { path($_) } is_arrayref( $args->{files} )
40 4         41 ? @{ $args->{files} }
41 4 50       17 : ( $args->{files} );
42             }
43              
44 5         227 foreach my $path (@paths) {
45              
46 5 50       26 die "Path $path does not exist" unless $path->exists;
47              
48 5 100       286 if ( $path->is_dir ) {
49              
50             my $iter = $path->iterator(
51             {
52             recurse => $args->{recurse} || 0,
53 4   50     116 follow_symlinks => $args->{follow_symlinks} || 0,
      50        
54             }
55             );
56              
57 4         162 while ( my $file = $iter->() ) {
58 33 100       3629 next unless $file->basename =~ $match;
59 12         383 push @files, $file;
60             }
61              
62             }
63             else {
64              
65 1         14 push @files, $path;
66              
67             }
68              
69             }
70              
71 5         234 return [ sort @files ];
72             }
73              
74              
75             sub run_data_tests {
76 5     5 1 21596 my ( $class, @args ) = @_;
77              
78             my %args =
79             ( ( @args == 1 ) && is_hashref( $args[0] ) )
80 5 50 33     41 ? %{ $args[0] }
  0         0  
81             : @args;
82              
83 5   50 0   22 my $filter = $args{filter} || sub { $_[0] };
  0         0  
84 5   66     64 my $parser = $args{parser} || $class->curry::parse_data_file;
85              
86 5         73 foreach my $file ( @{ $class->_build_data_files( \%args ) } ) {
  5         19  
87              
88 13         70531 note "Data: $file";
89              
90 13         4597 my $data = $parser->($file);
91              
92 13 100       3165 if ( is_arrayref($data) ) {
    50          
93              
94 4         17 my @cases = @$data;
95 4         8 my $i = 0;
96              
97 4         13 foreach my $case (@cases) {
98              
99             my $desc = sprintf(
100             '%s (%u of %u)',
101 14   33     75570 $case->{description} || $file->basename, #
102             ++$i, #
103             scalar(@cases) #
104             );
105              
106 14         221 $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 7424 my ( $class, $file ) = @_;
133              
134 13         58 my $path = $file->absolute;
135              
136 13     13   973 my $eval = sub { eval $_[0] }; ## no critic (ProhibitStringyEval)
  13         1168  
137              
138 13         40 my $package = __PACKAGE__ . "::Sandbox" . $Counter++;
139              
140 13         60 my $data = $eval->("package ${package}; do q{${path}} or die \$!;");
141              
142 13 100       28606 die "parse failed on $file: $@" if $@;
143 10 50       32 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         67 Class::Unload->unload($package);
147              
148 10         1209 return $data;
149             }
150              
151              
152             1;
153              
154             __END__