File Coverage

blib/lib/Tangerine/hook/testrequires.pm
Criterion Covered Total %
statement 46 46 100.0
branch 13 18 72.2
condition 18 23 78.2
subroutine 11 11 100.0
pod 1 1 100.0
total 89 99 89.9


line stmt bran cond sub pod time code
1             package Tangerine::hook::testrequires;
2             $Tangerine::hook::testrequires::VERSION = '0.23';
3 16     16   797 use 5.010;
  16         34  
4 16     16   45 use strict;
  16         18  
  16         227  
5 16     16   40 use warnings;
  16         16  
  16         298  
6 16     16   43 use parent 'Tangerine::Hook';
  16         16  
  16         54  
7 16     16   659 use Tangerine::HookData;
  16         18  
  16         243  
8 16     16   39 use Tangerine::Occurence;
  16         18  
  16         267  
9 16     16   49 use Tangerine::Utils qw(any stripquotelike $vre);
  16         14  
  16         6116  
10              
11             sub run {
12 148     148 1 135 my ($self, $s) = @_;
13 148         123 my %found;
14 148 100 100     253 if ($self->type eq 'compile' &&
    100 100        
      100        
      100        
      66        
15 195     195   639 (any { $s->[0] eq $_ } qw(use no)) && scalar(@$s) > 2 &&
16 151     151   1282 (any { $s->[1] eq $_ } qw(Test::Needs Test::Requires))) {
17 6         59 my ($version) = $s->[2] =~ $vre;
18 6   50     145 $version //= '';
19 6 50 33     19 return if !$version && stripquotelike($s->[2]) =~ /^v?5(?:\..*)?$/;
20 6 50       11 my $voffset = $version ? 3 : 2;
21 6         9 my @args;
22 6 50       11 if (scalar(@$s) > $voffset) {
23 6 50       10 return if $s->[$voffset] eq ';';
24 6         150 @args = @$s;
25 6         14 @args = @args[($voffset) .. $#args];
26 6         14 @args = stripquotelike(@args);
27             }
28 6 100       13 if (substr($s->[$voffset], 0, 1) eq '{') {
29 2         85 %found = @args;
30             } else {
31 4         32 %found = map { $_ => '' } @args;
  9         19  
32             }
33             } elsif ($self->type eq 'runtime' &&
34 18     18   70 (any { $s->[0] eq $_ } qw(test_needs test_requires)) && scalar(@$s) > 1) {
35 4 50       39 return if $s->[1] eq ';';
36 4         80 my @args = stripquotelike((@$s)[1..$#$s]);
37 4 100 66     19 $found{$args[0]} = $args[1] && $args[1] ne ';' ? $args[1] : '';
38             } else {
39             return
40 138         524 }
41             return Tangerine::HookData->new(
42             modules => {
43             map {
44 10         32 ( $_ => Tangerine::Occurence->new(version => $found{$_}) )
  17         35  
45             } keys %found,
46             },
47             )
48             }
49              
50             1;
51              
52             __END__