File Coverage

lib/Perl/PrereqScanner/NotQuiteLite/Parser/MooseXDeclare.pm
Criterion Covered Total %
statement 75 90 83.3
branch 24 42 57.1
condition 15 25 60.0
subroutine 11 11 100.0
pod 0 7 0.0
total 125 175 71.4


line stmt bran cond sub pod time code
1             package Perl::PrereqScanner::NotQuiteLite::Parser::MooseXDeclare;
2              
3 83     83   1412 use strict;
  83         187  
  83         2323  
4 83     83   435 use warnings;
  83         184  
  83         1994  
5 83     83   430 use Perl::PrereqScanner::NotQuiteLite::Util;
  83         188  
  83         87246  
6              
7             sub register { return {
8 82     82 0 632 use => {
9             'MooseX::Declare' => 'parse_moosex_declare_args',
10             },
11             }}
12              
13             sub parse_moosex_declare_args {
14 13     13 0 40 my ($class, $c, $used_module, $raw_tokens) = @_;
15              
16 13         67 $c->register_sub_parser(
17             'class',
18             [$class, 'parse_class_args', $used_module],
19             );
20 13         61 $c->register_sub_parser(
21             'role',
22             [$class, 'parse_role_args', $used_module],
23             );
24              
25 13         55 $c->register_keyword_parser(
26             'extends',
27             [$class, 'parse_extends_args', $used_module],
28             );
29 13         45 $c->register_keyword_parser(
30             'with',
31             [$class, 'parse_with_args', $used_module],
32             );
33              
34 13         43 $c->register_keyword_parser(
35             'namespace',
36             [$class, 'parse_namespace_args', $used_module],
37             );
38              
39 13         59 $c->register_sub_keywords(qw/
40             class method role
41             before after around override augment
42             /);
43              
44 13         74 $c->prototype_re(qr{\G(\((?:[^\\\(\)]*(?:\\.[^\\\(\)]*)*)\))});
45             }
46              
47             sub parse_class_args {
48 18     18 0 45 my ($class, $c, $used_module, $raw_tokens) = @_;
49              
50 18   100     52 my $namespace = $c->stash->{moosex_declare}{namespace} || '';
51              
52 18         70 my $tokens = convert_string_tokens($raw_tokens);
53 18         42 shift @$tokens; # discard class
54              
55 18 50 50     63 my $class_name = (shift @$tokens || [])->[0] or return;
56 18 100       50 if ($class_name eq '::') {
57 4   50     17 my $name = (shift @$tokens || [])->[0];
58 4         12 $class_name = $namespace . '::' . $name;
59             }
60              
61 18         45 my $prev = '';
62 18         75 while(my $token = shift @$tokens) {
63 11 100 100     48 if ($token->[0] eq 'extends' or $token->[0] eq 'with') {
64 9         16 while(1) {
65 10   50     30 my $name = (shift @$tokens || [])->[0];
66 10 100       26 if ($name eq '::') {
67 2   50     9 $name = $namespace . '::' . (shift @$tokens || [])->[0];
68             }
69 10 50       28 $c->add($name => 0) if is_module_name($name);
70 10 100       382 last if !@$tokens;
71 4         9 my $next_token = $tokens->[0];
72 4 100       17 last if $next_token->[0] ne ',';
73 1         3 shift @$tokens;
74             }
75             }
76             }
77             }
78              
79             sub parse_role_args {
80 8     8 0 23 my ($class, $c, $used_module, $raw_tokens) = @_;
81              
82 8   100     29 my $namespace = $c->stash->{moosex_declare}{namespace} || '';
83              
84 8         29 my $tokens = convert_string_tokens($raw_tokens);
85 8         19 shift @$tokens; # discard role
86              
87 8         18 my $class_name = (shift @$tokens)->[0];
88 8 100       21 if ($class_name eq '::') {
89 5         13 my $name = (shift @$tokens)->[0];
90 5         13 $class_name = $namespace . '::' . $name;
91             }
92              
93 8         16 my $prev = '';
94 8         37 while(my $token = shift @$tokens) {
95 1 50       5 if ($token->[0] eq 'with') {
96 0         0 while(1) {
97 0         0 my $name = (shift @$tokens)->[0];
98 0 0       0 if ($name eq '::') {
99 0         0 $name = $namespace . '::' . (shift @$tokens)->[0];
100             }
101 0 0       0 $c->add($name => 0) if is_module_name($name);
102 0 0       0 last if !@$tokens;
103 0         0 my $next_token = $tokens->[0];
104 0 0       0 last if $next_token->[0] ne ',';
105 0         0 shift @$tokens;
106             }
107             }
108             }
109             }
110              
111             sub parse_namespace_args {
112 2     2 0 8 my ($class, $c, $used_module, $raw_tokens) = @_;
113              
114 2         8 my $tokens = convert_string_tokens($raw_tokens);
115 2         5 shift @$tokens; # discard namespace
116              
117 2         8 my $first_token = (shift @$tokens)->[0];
118 2 50       8 if (is_module_name($first_token)) {
119 2         10 $c->stash->{moosex_declare}{namespace} = $first_token;
120             }
121             }
122              
123 1     1 0 6 sub parse_extends_args { shift->_parse_loader_args(@_) }
124 9     9 0 28 sub parse_with_args { shift->_parse_loader_args(@_) }
125              
126             sub _parse_loader_args {
127 10     10   22 my ($class, $c, $used_module, $raw_tokens) = @_;
128              
129 10   100     29 my $namespace = $c->stash->{moosex_declare}{namespace} || '';
130              
131 10         33 my $tokens = convert_string_tokens($raw_tokens);
132 10         20 shift @$tokens; # discard extends, with;
133              
134 10         20 my $prev;
135 10         28 while(my $token = shift @$tokens) {
136 26 100       62 if (!ref $token) {
137 7 100       39 if ($token =~ /^::/) {
138 5         18 $token = $namespace . $token;
139             }
140 7         29 $c->add($token => 0);
141 7         224 $prev = $token;
142 7         23 next;
143             }
144 19   50     45 my $desc = $token->[1] || '';
145 19 100       74 if ($desc eq '{}') {
146 3 50       3 my @hash_tokens = @{$token->[0] || []};
  3         9  
147 3         7 for(my $i = 0, my $len = @hash_tokens; $i < $len; $i++) {
148 17 50 33     47 if ($hash_tokens[$i][0] eq '-version' and $i < $len - 2) {
149 0           my $maybe_version_token = $hash_tokens[$i + 2];
150 0           my $maybe_version = $maybe_version_token->[0];
151 0 0         if (ref $maybe_version) {
152 0           $maybe_version = $maybe_version->[0];
153             }
154 0 0 0       if ($prev and is_version($maybe_version)) {
155 0           $c->add($prev => $maybe_version);
156             }
157             }
158             }
159             }
160             }
161             }
162              
163             1;
164              
165             __END__