File Coverage

blib/lib/Tangerine/hook/moduleruntime.pm
Criterion Covered Total %
statement 39 39 100.0
branch 6 6 100.0
condition 8 12 66.6
subroutine 12 12 100.0
pod 1 1 100.0
total 66 70 94.2


line stmt bran cond sub pod time code
1             package Tangerine::hook::moduleruntime;
2             $Tangerine::hook::moduleruntime::VERSION = '0.23';
3 16     16   859 use 5.010;
  16         38  
4 16     16   46 use strict;
  16         13  
  16         231  
5 16     16   44 use warnings;
  16         18  
  16         308  
6 16     16   43 use parent 'Tangerine::Hook';
  16         16  
  16         89  
7 16     16   688 use Tangerine::HookData;
  16         20  
  16         225  
8 16     16   41 use Tangerine::Occurence;
  16         17  
  16         261  
9 16     16   45 use Tangerine::Utils qw(any none stripquotelike);
  16         23  
  16         4418  
10              
11             sub run {
12 142     142 1 126 my ($self, $s) = @_;
13 142         170 my @routines = qw(require_module use_module use_package_optimistically);
14 142 100 66 202   329 if ((any { $s->[0] eq $_ } qw(use no)) && scalar(@$s) > 1 &&
  202   100     652  
15             $s->[1] eq 'Module::Runtime') {
16 2         41 return Tangerine::HookData->new( hooks => [
17             Tangerine::hook::moduleruntime->new(type => 'runtime') ] );
18             }
19             # NOTE: For the sake of simplicity, we only check for one subroutine
20             # call per statement.
21 140 100 66 6   1712 if ($self->type eq 'runtime' && any { my $f = $_; any { $_ eq $f } @$s }
  6         23  
  6         13  
  25         182  
22             @routines) {
23 3     15   32 while (none { $s->[0] eq $_ } @routines) {
  15         60  
24 3         25 shift @$s;
25             }
26 3   33     32 for (my $clip = 0; $clip <= $#$s && $clip < 3; $clip++) {
27 9 100   17   105 if (any { $s->[$clip] eq $_ } qw(-> ;)) {
  17         101  
28 3         25 @$s = @$s[0..$clip-1];
29             last
30 3         5 }
31             }
32 3         9 my @args = stripquotelike(@$s[1..$#$s]);
33 3         7 return Tangerine::HookData->new(
34             modules => {
35             $args[0] => Tangerine::Occurence->new(
36             version => $args[1]
37             ),
38             },
39             );
40             }
41             }
42              
43             1;
44              
45             __END__