File Coverage

blib/lib/Tangerine/hook/list.pm
Criterion Covered Total %
statement 62 62 100.0
branch 22 24 91.6
condition 13 14 92.8
subroutine 13 13 100.0
pod 1 1 100.0
total 111 114 97.3


line stmt bran cond sub pod time code
1             package Tangerine::hook::list;
2             $Tangerine::hook::list::VERSION = '0.23';
3 16     16   783 use 5.010;
  16         36  
4 16     16   48 use strict;
  16         18  
  16         231  
5 16     16   50 use warnings;
  16         24  
  16         310  
6 16     16   42 use parent 'Tangerine::Hook';
  16         17  
  16         51  
7 16     16   665 use Tangerine::HookData;
  16         19  
  16         223  
8 16     16   41 use Tangerine::Occurence;
  16         19  
  16         264  
9 16     16   49 use Tangerine::Utils qw(any stripquotelike $vre);
  16         17  
  16         7784  
10              
11             sub run {
12 142     142 1 126 my ($self, $s) = @_;
13 142 100 100 199   395 if ((any { $s->[0] eq $_ } qw(use no)) && scalar(@$s) > 2 &&
  199   100     633  
14 657     657   3904 (any { $s->[1] eq $_ }
15             qw(aliased base mixin mixin::with Mojo::Base ok parent superclass
16             Test::Class::Most))) {
17 17         154 my ($version) = $s->[2] =~ $vre;
18 17   50     109 $version //= '';
19 17 50       22 my $voffset = $version ? 3 : 2;
20 17         57 my @args;
21 17 50       28 if (scalar(@$s) > $voffset) {
22 17 100       25 return if $s->[$voffset] eq ';';
23 16         131 @args = @$s;
24 16         38 @args = @args[($voffset) .. $#args];
25 16         31 @args = stripquotelike(@args);
26 10         35 @args = grep { !/^-norequire$/ } @args
27 16 100   30   53 if any { $s->[1] eq $_ } qw/parent superclass/;
  30         132  
28 16 100       110 @args = grep { !/^-(base|strict)$/ } @args
  3         23  
29             if $s->[1] eq 'Mojo::Base';
30             }
31             @args = $args[0]
32 59     59   260 if $args[0] && any { $s->[1] eq $_ }
33 16 100 100     131 qw/aliased mixin mixin::with Mojo::Base ok/;
34 16 100       118 if ($s->[1] eq 'Test::Class::Most') {
35 2         13 my $tcmparent;
36             my @results;
37 2         6 for my $arg (@args) {
38 13 100       26 if ($tcmparent) {
39 5 100   10   11 if (any { $arg eq $_ } qw/attributes is_abstract/) {
  10         16  
40 1         7 undef $tcmparent;
41             next
42 1         3 }
43 4         8 push @results, $arg
44             } else {
45 8 100       9 if ($arg eq 'parent') {
46 3         21 $tcmparent++;
47             undef @results
48 3         4 }
49             }
50             }
51             @args = @results
52 2         3 }
53 16         89 my %found;
54 16         36 for (my $i = 0; $i < scalar(@args); $i++) {
55 18         30 $found{$args[$i]} = '';
56 18 100 100     69 if ($args[$i+1] && $args[$i+1] =~ /^v?\d+(?:\.\d+)*$/) {
57 1         2 $found{$args[$i]} = $args[$i+1];
58 1         4 $i++
59             }
60             }
61             return Tangerine::HookData->new(
62             modules => {
63             map {
64 16         27 ( $_ => Tangerine::Occurence->new(version => $found{$_}) )
  18         36  
65             } keys %found,
66             },
67             );
68             }
69 125         1098 return;
70             }
71              
72             1;
73              
74             __END__