File Coverage

lib/Perl/PrereqScanner/NotQuiteLite/Parser/Moose.pm
Criterion Covered Total %
statement 68 79 86.0
branch 16 24 66.6
condition 5 8 62.5
subroutine 11 13 84.6
pod 0 9 0.0
total 100 133 75.1


line stmt bran cond sub pod time code
1             package Perl::PrereqScanner::NotQuiteLite::Parser::Moose;
2              
3 84     84   1424 use strict;
  84         187  
  84         2257  
4 84     84   422 use warnings;
  84         197  
  84         1937  
5 84     84   449 use Perl::PrereqScanner::NotQuiteLite::Util;
  84         185  
  84         76917  
6              
7             # There are so many Moose-like variants
8              
9             # Like Moose; modules that are not listed here but have Moose
10             # in their name are implicitly treated like these as well
11             my @ExportsExtendsAndWith = qw/
12             Moose Moo Mouse MooX Moo::Lax Moos
13             MooseX::App MooseX::Singleton MooseX::SingletonMethod
14              
15             HTML::FormHandler::Moose Test::Class::Moose
16              
17             App::GHPT::Wrapper::OurMoose App::wmiirc::Plugin Ark
18             Bot::Backbone::Service Bubblegum::Class CatalystX::Declare
19             Cogwheel CPAN::Testers::Backend::Base Dancer2::Plugin
20             Data::Object::Class DBICx::Modeler::Model Digital::Driver
21             Elastic::Doc Fey::ORM::Table Form::Factory::Processor
22             Jedi::App Momo Moonshine::Magic Moxie Nile::Base
23             Parse::FixedRecord Pcore Reaction::Class Reaction::UI::WidgetClass
24             Squirrel Statocles::Base TAEB::OO Test::Able Test::Roo
25             Web::Simple XML::Rabbit
26             /;
27              
28             # Like Moose::Role; modules that are not listed here but have Role
29             # in their name are implicitly treated like these as well
30              
31             my @ExportsWith = qw/
32             Moose::Role Moo::Role Mouse::Role
33             MooseX::Role::Parameterized
34             Mason::PluginRole Mojo::RoleTiny MooX::Cmd
35             Role::Basic Role::Tiny Role::Tiny::With Reflex::Role
36             Template::Caribou Test::Routine App::SimulateReads::Base
37             /;
38              
39             # Like Mo
40             my @ExportsExtends = qw/
41             Mo
42             Lingy::Base OptArgs2::Mo Parse::SAMGov::Mo Pegex::Base
43             Sub::Mage TestML::Base Type::Utils VSO
44             /;
45              
46             sub register {
47 83     83 0 377 my ($class, %args) = @_;
48              
49             # Make sure everything is unique
50 83 50       210 my %exports_extends_and_with = map {$_ => 1} (@ExportsExtendsAndWith, @{$args{exports_extends_and_with} || []});
  3486         7012  
  83         563  
51 83 50       323 my %exports_extends = map {$_ => 1} (@ExportsExtends, @{$args{exports_extends} || []});
  747         1625  
  83         456  
52 83 50       228 my %exports_with = map {$_ => 1} (@ExportsWith, @{$args{exports_with} || []});
  1162         2525  
  83         2278  
53              
54 83         1849 for my $module (keys %exports_with) {
55 1162 50       2275 if (exists $exports_extends_and_with{$module}) {
56 0         0 delete $exports_with{$module};
57 0         0 next;
58             }
59 1162 50       2211 if (exists $exports_extends{$module}) {
60 0         0 $exports_extends_and_with{$module} = 1;
61 0         0 delete $exports_with{$module};
62 0         0 next;
63             }
64             }
65 83         334 for my $module (keys %exports_extends) {
66 747 50       1481 if (exists $exports_extends_and_with{$module}) {
67 0         0 delete $exports_extends{$module};
68 0         0 next;
69             }
70             }
71              
72 83         179 my %mapping;
73 83         283 for my $module (keys %exports_with) {
74 1162         2143 $mapping{use}{$module} = 'register_with';
75 1162         2111 $mapping{no}{$module} = 'remove_with';
76             }
77 83         323 for my $module (keys %exports_extends) {
78 747         1289 $mapping{use}{$module} = 'register_extends';
79 747         1304 $mapping{no}{$module} = 'remove_extends';
80             }
81 83         536 for my $module (keys %exports_extends_and_with) {
82 3486         6008 $mapping{use}{$module} = 'register_extends_and_with';
83 3486         6352 $mapping{no}{$module} = 'remove_extends_and_with';
84             }
85              
86 83         902 return \%mapping;
87             }
88              
89             sub register_extends_and_with {
90 54     54 0 165 my ($class, $c, $used_module, $raw_tokens) = @_;
91              
92 54         276 $c->register_keyword_parser(
93             'extends',
94             [$class, 'parse_extends_args', $used_module],
95             );
96 54         205 $c->register_keyword_parser(
97             'with',
98             [$class, 'parse_with_args', $used_module],
99             );
100             }
101              
102             sub register_with {
103 3     3 0 9 my ($class, $c, $used_module, $raw_tokens) = @_;
104              
105 3         11 $c->register_keyword_parser(
106             'with',
107             [$class, 'parse_with_args', $used_module],
108             );
109             }
110              
111             sub register_extends {
112 2     2 0 5 my ($class, $c, $used_module, $raw_tokens) = @_;
113              
114 2         7 $c->register_keyword_parser(
115             'extends',
116             [$class, 'parse_extends_args', $used_module],
117             );
118             }
119              
120             sub remove_extends_and_with {
121 1     1 0 4 my ($class, $c, $used_module, $raw_tokens) = @_;
122              
123 1         5 $c->remove_keyword('extends');
124 1         3 $c->remove_keyword('with');
125             }
126              
127             sub remove_with {
128 0     0 0 0 my ($class, $c, $used_module, $raw_tokens) = @_;
129              
130 0         0 $c->remove_keyword('with');
131             }
132              
133             sub remove_extends {
134 0     0 0 0 my ($class, $c, $used_module, $raw_tokens) = @_;
135              
136 0         0 $c->remove_keyword('extends');
137             }
138              
139 27     27 0 94 sub parse_extends_args { shift->_parse_loader_args(@_) }
140 33     33 0 109 sub parse_with_args { shift->_parse_loader_args(@_) }
141              
142             sub _parse_loader_args {
143 60     60   161 my ($class, $c, $used_module, $raw_tokens) = @_;
144              
145 60         194 my $tokens = convert_string_tokens($raw_tokens);
146 60         115 shift @$tokens; # discard extends, with;
147              
148 60         97 my $prev;
149 60         144 for my $token (@$tokens) {
150 240 100       550 if (!ref $token) {
151 89         302 $c->add($token => 0);
152 89         2978 $prev = $token;
153 89         230 next;
154             }
155 151   100     385 my $desc = $token->[1] || '';
156 151 100       553 if ($desc eq '{}') {
157 29 50       52 my @hash_tokens = @{$token->[0] || []};
  29         90  
158 29         85 for(my $i = 0, my $len = @hash_tokens; $i < $len; $i++) {
159 104 100 66     3306 if ($hash_tokens[$i][0] eq '-version' and $i < $len - 2) {
160 27         57 my $maybe_version_token = $hash_tokens[$i + 2];
161 27         55 my $maybe_version = $maybe_version_token->[0];
162 27 100       62 if (ref $maybe_version) {
163 18         40 $maybe_version = $maybe_version->[0];
164             }
165 27 50 33     99 if ($prev and is_version($maybe_version)) {
166 27         78 $c->add($prev => $maybe_version);
167             }
168             }
169             }
170             }
171             }
172             }
173              
174             1;
175              
176             __END__