File Coverage

blib/lib/Tangerine/hook/moduleruntime.pm
Criterion Covered Total %
statement 42 42 100.0
branch 6 6 100.0
condition 8 12 66.6
subroutine 13 13 100.0
pod 1 1 100.0
total 70 74 94.5


line stmt bran cond sub pod time code
1             package Tangerine::hook::moduleruntime;
2             $Tangerine::hook::moduleruntime::VERSION = '0.19';
3 15     15   1066 use 5.010;
  15         45  
4 15     15   73 use strict;
  15         23  
  15         367  
5 15     15   68 use warnings;
  15         21  
  15         492  
6 15     15   99 use parent 'Tangerine::Hook';
  15         23  
  15         83  
7 15     15   1004 use List::MoreUtils qw(any none);
  15         21  
  15         100  
8 15     15   6187 use Tangerine::HookData;
  15         21  
  15         356  
9 15     15   61 use Tangerine::Occurence;
  15         19  
  15         389  
10 15     15   63 use Tangerine::Utils qw(stripquotelike);
  15         19  
  15         5362  
11              
12             sub run {
13 132     132 1 161 my ($self, $s) = @_;
14 132         225 my @routines = qw(require_module use_module use_package_optimistically);
15 132 100 66 188   433 if ((any { $s->[0] eq $_ } qw(use no)) && scalar(@$s) > 1 &&
  188   100     1001  
16             $s->[1] eq 'Module::Runtime') {
17 2         89 return Tangerine::HookData->new( hooks => [
18             Tangerine::hook::moduleruntime->new(type => 'runtime') ] );
19             }
20             # NOTE: For the sake of simplicity, we only check for one subroutine
21             # call per statement.
22 130 100 66 6   2271 if ($self->type eq 'runtime' && any { my $f = $_; any { $_ eq $f } @$s }
  6         44  
  6         32  
  25         376  
23             @routines) {
24 3     15   62 while (none { $s->[0] eq $_ } @routines) {
  15         126  
25 3         50 shift @$s;
26             }
27 3   33     62 for (my $clip = 0; $clip <= $#$s && $clip < 3; $clip++) {
28 9 100   17   214 if (any { $s->[$clip] eq $_ } qw(-> ;)) {
  17         212  
29 3         54 @$s = @$s[0..$clip-1];
30             last
31 3         12 }
32             }
33 3         23 my @args = stripquotelike(@$s[1..$#$s]);
34 3         53 return Tangerine::HookData->new(
35             modules => {
36             $args[0] => Tangerine::Occurence->new(
37             version => $args[1]
38             ),
39             },
40             );
41             }
42             }
43              
44             1;
45              
46             __END__