File Coverage

blib/lib/Tangerine/hook/mooselike.pm
Criterion Covered Total %
statement 50 50 100.0
branch 15 18 83.3
condition 14 15 93.3
subroutine 14 14 100.0
pod 1 1 100.0
total 94 98 95.9


line stmt bran cond sub pod time code
1             package Tangerine::hook::mooselike;
2             $Tangerine::hook::mooselike::VERSION = '0.19';
3 15     15   1012 use 5.010;
  15         41  
4 15     15   66 use strict;
  15         20  
  15         363  
5 15     15   57 use warnings;
  15         24  
  15         454  
6 15     15   61 use parent 'Tangerine::Hook';
  15         22  
  15         75  
7 15     15   919 use List::MoreUtils qw(any none);
  15         21  
  15         93  
8 15     15   5616 use Tangerine::Hook;
  15         26  
  15         310  
9 15     15   58 use Tangerine::HookData;
  15         23  
  15         364  
10 15     15   58 use Tangerine::Utils qw(stripquotelike);
  15         19  
  15         4888  
11              
12             sub run {
13 152     152 1 175 my ($self, $s) = @_;
14 152 100 100     316 if ($self->type eq 'compile' && $s->[0] eq 'use' &&
    100 66        
      100        
      100        
15 297     297   2511 scalar(@$s) > 1 && (any { $s->[1] eq $_ } qw(Moose Mouse Moo Mo))) {
16 6         70 return Tangerine::HookData->new(
17             hooks => [
18             Tangerine::hook::mooselike->new(type => 'runtime'),
19             ],
20             );
21 45     45   204 } elsif ($self->type eq 'runtime' && any { $s->[0] eq $_ } qw(extends with)) {
22 7 100 100 9   94 if (scalar(@$s) > 2 && none { $s->[2] eq $_ } ('=>', ',', ';')) {
  9         55  
23             # Bail out; most likely an indirect object method call
24             return
25 1         21 }
26 6         52 my %modules;
27             my $last;
28 6         14 for (my $i = 1; $i < scalar(@$s); $i++) {
29 22 100   41   127 next if any { $s->[$i] eq $_ } ('=>', ',');
  41         407  
30 16 100       288 last if $s->[$i] eq ';';
31 10 50       269 $s->[$i] = substr($s->[$i], 1, -1) if substr($s->[$i], 0, 1) eq '(';
32 10 100       156 if (substr($s->[$i], 0, 1) ne '{') {
33 6         29 my @parents = stripquotelike($s->[$i]);
34 6         8 $last = $parents[-1];
35 6         31 $modules{$_} = undef for @parents;
36             } else {
37 4 50       131 next unless $last;
38 15     15   8219 $modules{$last} = $+{version} if
  15         6206  
  15         3073  
39 4 50       7 $s->[$i] =~ /^\{.*-version\s*?(=>|,)\s*?((qq?\s*?[^\w]\s*)|'|")?v?
40             (?\d+?(\.\d+)*)((\s*?[^\w])|'|")?.*\}\s*$/xso;
41 4         205 $last = undef;
42             }
43             }
44             return Tangerine::HookData->new(
45             modules => {
46             map {
47 6         73 ( $_ => Tangerine::Occurence->new(version => $modules{$_}) )
  7         20  
48             } keys %modules,
49             },
50             );
51             }
52 139         601 return;
53             }
54              
55             1;
56              
57             __END__