File Coverage

blib/lib/Tangerine/hook/mooselike.pm
Criterion Covered Total %
statement 47 47 100.0
branch 15 18 83.3
condition 14 15 93.3
subroutine 13 13 100.0
pod 1 1 100.0
total 90 94 95.7


line stmt bran cond sub pod time code
1             package Tangerine::hook::mooselike;
2             $Tangerine::hook::mooselike::VERSION = '0.23';
3 16     16   768 use 5.010;
  16         33  
4 16     16   46 use strict;
  16         16  
  16         230  
5 16     16   42 use warnings;
  16         15  
  16         333  
6 16     16   42 use parent 'Tangerine::Hook';
  16         20  
  16         59  
7 16     16   728 use Tangerine::Hook;
  16         21  
  16         218  
8 16     16   37 use Tangerine::HookData;
  16         15  
  16         272  
9 16     16   44 use Tangerine::Utils qw(any none stripquotelike);
  16         15  
  16         4436  
10              
11             sub run {
12 162     162 1 145 my ($self, $s) = @_;
13 162 100 100     247 if ($self->type eq 'compile' && $s->[0] eq 'use' &&
    100 66        
      100        
      100        
14 396     396   2413 scalar(@$s) > 1 && (any { $s->[1] eq $_ }
15             qw(Moose Mouse Moo Mo Role::Tiny::With))) {
16 6         42 return Tangerine::HookData->new(
17             hooks => [
18             Tangerine::hook::mooselike->new(type => 'runtime'),
19             ],
20             );
21 45     45   145 } elsif ($self->type eq 'runtime' && any { $s->[0] eq $_ } qw(extends with)) {
22 7 100 100 9   71 if (scalar(@$s) > 2 && none { $s->[2] eq $_ } ('=>', ',', ';')) {
  9         32  
23             # Bail out; most likely an indirect object method call
24             return
25 1         11 }
26 6         36 my %modules;
27             my $last;
28 6         11 for (my $i = 1; $i < scalar(@$s); $i++) {
29 22 100   41   105 next if any { $s->[$i] eq $_ } ('=>', ',');
  41         291  
30 16 100       209 last if $s->[$i] eq ';';
31 10 50       160 $s->[$i] = substr($s->[$i], 1, -1) if substr($s->[$i], 0, 1) eq '(';
32 10 100       115 if (substr($s->[$i], 0, 1) ne '{') {
33 6         20 my @parents = stripquotelike($s->[$i]);
34 6         6 $last = $parents[-1];
35 6         22 $modules{$_} = undef for @parents;
36             } else {
37 4 50       99 next unless $last;
38 16     16   6498 $modules{$last} = $+{version} if
  16         5095  
  16         2653  
39 4 50       4 $s->[$i] =~ /^\{.*-version\s*?(?:=>|,)\s*?(?:(?:qq?\s*?[^\w]\s*)|'|")?v?
40             (?\d+?(?:\.\d+)*)(?:(?:\s*?[^\w])|'|")?.*\}\s*$/xso;
41 4         141 $last = undef;
42             }
43             }
44             return Tangerine::HookData->new(
45             modules => {
46             map {
47 6         49 ( $_ => Tangerine::Occurence->new(version => $modules{$_}) )
  7         14  
48             } keys %modules,
49             },
50             );
51             }
52 149         479 return;
53             }
54              
55             1;
56              
57             __END__