File Coverage

blib/lib/Method/Signatures/Signature.pm
Criterion Covered Total %
statement 114 118 96.6
branch 37 40 92.5
condition 18 18 100.0
subroutine 20 22 90.9
pod 1 9 11.1
total 190 207 91.7


line stmt bran cond sub pod time code
1             package Method::Signatures::Signature;
2              
3 62     62   12873 use Carp;
  62         73  
  62         3317  
4 62     62   596 use Mouse;
  62         19219  
  62         279  
5 62     62   33996 use Method::Signatures::Types;
  62         100  
  62         1407  
6 62     62   594 use Method::Signatures::Parameter;
  62         67  
  62         1195  
7 62     62   190 use Method::Signatures::Utils qw(new_ppi_doc sig_parsing_error DEBUG);
  62         57  
  62         3112  
8 62     62   232 use List::Util qw(all);
  62         58  
  62         73377  
9              
10             my $INF = ( 0 + "inf" ) == 0 ? 9e9999 : "inf";
11              
12             has num_lines =>
13             is => 'rw',
14             isa => 'Int',
15             lazy => 1,
16             default => sub {
17             my $self = shift;
18             my $num =()= $self->signature_string =~ /\n/g;
19             return $num + 1;
20             };
21              
22             # The unmodified, uncleaned up original signature for reference
23             has signature_string =>
24             is => 'ro',
25             isa => 'Str',
26             required => 1;
27              
28             # Just the parameter part of the signature, no invocant
29             has parameter_string =>
30             is => 'ro',
31             isa => 'Str',
32             lazy => 1,
33             builder => '_build_parameter_string';
34              
35             # The parsed Method::Signature::Parameter objects
36             has parameters =>
37             is => 'ro',
38             isa => 'ArrayRef[Method::Signatures::Parameter]',
39             lazy => 1,
40             builder => '_build_parameters';
41              
42             has named_parameters =>
43             is => 'ro',
44             isa => 'ArrayRef[Method::Signatures::Parameter]',
45             default => sub { [] };
46              
47             has positional_parameters =>
48             is => 'ro',
49             isa => 'ArrayRef[Method::Signatures::Parameter]',
50             default => sub { [] };
51              
52             has optional_parameters =>
53             is => 'ro',
54             isa => 'ArrayRef[Method::Signatures::Parameter]',
55             default => sub { [] };
56              
57             has optional_positional_parameters =>
58             is => 'ro',
59             isa => 'ArrayRef[Method::Signatures::Parameter]',
60             default => sub { [] };
61              
62             has slurpy_parameters =>
63             is => 'ro',
64             isa => 'ArrayRef[Method::Signatures::Parameter]',
65             default => sub { [] };
66              
67             has yadayada_parameters =>
68             is => 'ro',
69             isa => 'ArrayRef[Method::Signatures::Parameter]',
70             default => sub { [] };
71              
72              
73             sub num_named {
74 660     660 0 462 return scalar @{$_[0]->named_parameters};
  660         1822  
75             }
76              
77             sub num_positional {
78 392     392 0 268 return scalar @{$_[0]->positional_parameters};
  392         1682  
79             }
80              
81             sub num_optional {
82 0     0 0 0 return scalar @{$_[0]->optional_parameters};
  0         0  
83             }
84              
85             sub num_optional_positional {
86 174     174 0 148 return scalar @{$_[0]->optional_positional_parameters};
  174         835  
87             }
88              
89             sub num_slurpy {
90 479     479 0 378 return scalar @{$_[0]->slurpy_parameters};
  479         1436  
91             }
92              
93             sub num_yadayada {
94 52     52 0 52 return scalar @{$_[0]->yadayada_parameters};
  52         388  
95             }
96              
97             # Anything we need to pull out before the invocant.
98             # Primary example would be the $orig for around modifiers in Moose/Mouse
99             has pre_invocant =>
100             is => 'rw',
101             isa => 'Maybe[Str]',
102             default => '';
103              
104             has invocant =>
105             is => 'rw',
106             isa => 'Maybe[Str]',
107             default => '';
108              
109             sub has_invocant {
110 0 0   0 0 0 return $_[0]->invocant ? 1 : 0;
111             }
112              
113             # How big can @_ be?
114             has max_argv_size =>
115             is => 'rw',
116             isa => 'Int|Inf';
117              
118             # The maximum logical arguments (name => value counts as one argument)
119             has max_args =>
120             is => 'rw',
121             isa => 'Int|Inf';
122              
123             # A PPI::Document representing the list of parameters
124             has ppi_doc =>
125             is => 'ro',
126             isa => 'PPI::Document',
127             lazy => 1,
128             default => sub {
129             my $code = $_[0]->parameter_string;
130             return new_ppi_doc(\$code);
131             };
132              
133             # If set, no checks will be done on the signature or parameters
134             has no_checks =>
135             is => 'rw',
136             isa => 'Bool',
137             default => 0;
138              
139              
140             sub BUILD {
141 242     242 1 289 my $self = shift;
142              
143 242         232 for my $sig (@{$self->parameters}) {
  242         907  
144             # Handle "don't care" specifier
145 333 100       742 if ($sig->is_yadayada) {
146 6         7 push @{$self->slurpy_parameters}, $sig;
  6         16  
147 6         7 push @{$self->yadayada_parameters}, $sig;
  6         14  
148 6         11 next;
149             }
150              
151 327 100       1165 $sig->check($self) unless $self->no_checks;
152              
153 315 100       667 push @{$self->named_parameters}, $sig if $sig->is_named;
  47         98  
154 315 100       521 push @{$self->positional_parameters}, $sig if $sig->is_positional;
  268         510  
155 315 100       654 push @{$self->optional_parameters}, $sig if $sig->is_optional;
  176         361  
156 315 100 100     553 push @{$self->optional_positional_parameters}, $sig
  133         236  
157             if $sig->is_optional and $sig->is_positional;
158 315 100       687 push @{$self->slurpy_parameters}, $sig if $sig->is_slurpy;
  30         68  
159              
160 315         639 DEBUG( "sig: ", $sig );
161             }
162              
163 228         437 $self->_calculate_max_args;
164 228 100       734 $self->check unless $self->no_checks;
165              
166 225         640 return;
167             }
168              
169              
170             sub _calculate_max_args {
171 228     228   221 my $self = shift;
172              
173             # If there's a slurpy argument, the max is infinity.
174 228 100       357 if( $self->num_slurpy ) {
175 32         167 $self->max_argv_size($INF);
176 32         92 $self->max_args($INF);
177              
178 32         36 return;
179             }
180              
181 196         321 $self->max_argv_size( ($self->num_named * 2) + $self->num_positional );
182 196         339 $self->max_args( $self->num_named + $self->num_positional );
183              
184 196         227 return;
185             }
186              
187              
188             # Check the integrity of the signature as a whole
189             sub check {
190 213     213 0 198 my $self = shift;
191              
192             # Check that slurpy arguments come at the end
193 213 100 100     271 if(
      100        
194             $self->num_slurpy &&
195             !($self->num_yadayada || $self->positional_parameters->[-1]->is_slurpy)
196             )
197             {
198 3         5 my $slurpy_param = $self->slurpy_parameters->[0];
199 3         5 sig_parsing_error("Slurpy parameter '@{[$slurpy_param->variable]}' must come at the end");
  3         19  
200             }
201              
202 210         219 return 1;
203             }
204              
205              
206             sub _strip_ws {
207 336     336   765 $_[1] =~ s/^\s+//;
208 336         890 $_[1] =~ s/\s+$//;
209             }
210              
211              
212             my $IDENTIFIER = qr{ [^\W\d] \w* }x;
213             sub _build_parameter_string {
214 242     242   246 my $self = shift;
215              
216 242         421 my $sig_string = $self->signature_string;
217 242         196 my $invocant;
218              
219             # Extract an invocant, if one is present.
220 242 100       3977 if ($sig_string =~ s{ ^ \s* (\$ $IDENTIFIER) \s* : \s* }{}x) {
221 13         57 $self->invocant($1);
222             }
223              
224             # The siganture, minus the invocant, is just the list of parameters
225 242         854 return $sig_string;
226             }
227              
228              
229             sub _build_parameters {
230 242     242   239 my $self = shift;
231              
232 242         695 my $param_string = $self->parameter_string;
233 242 100       872 return [] unless $param_string =~ /\S/;
234              
235 207         637 my $ppi = $self->ppi_doc;
236 207         763 $ppi->prune('PPI::Token::Comment');
237              
238 207         76046 my $statement = $ppi->find_first("PPI::Statement");
239 207 50       29365 sig_parsing_error("Could not understand parameter list specification: $param_string")
240             unless $statement;
241 207         841 my $token = $statement->first_token;
242              
243             # Split the signature into parameters as tokens.
244 207         2414 my @tokens_by_param = ([]);
245 207         303 do {
246 1570 100 100     21788 if( $token->class eq "PPI::Token::Magic"
      100        
247             and $token->content eq '$,'
248             and _all_tokens_in_listref_are_whitespace($tokens_by_param[-1]))
249             {
250             # a placeholder scalar with no constraints gets parsed by PPI as if it's the special var "$,"
251             # it needs to be split up into 2 tokens, "$" and ","
252 2         19 my $bare_dollar_token = PPI::Token::Cast->new('$');
253 2         17 $token->insert_after($bare_dollar_token);
254 2         93 $bare_dollar_token->insert_after(PPI::Token::Operator->new(','));
255 2         66 $token->remove;
256 2         49 $token = $bare_dollar_token;
257             }
258              
259 1570 100 100     5540 if( $token->class eq "PPI::Token::Operator" and $token->content eq ',' )
260             {
261 132         934 push @tokens_by_param, [];
262             }
263             else {
264 1438         4587 push @{$tokens_by_param[-1]}, $token;
  1438         1850  
265             }
266              
267             # "Type: $arg" is interpreted by PPI as a label, which is lucky for us.
268 1570 100       2473 $token = $token->class eq 'PPI::Token::Label'
269             ? $token->next_token : $token->next_sibling;
270             } while( $token );
271              
272             # Turn those token sets into Parameter objects.
273 207         3329 my $idx = 0;
274 207         223 my @params;
275 207         380 for my $tokens (@tokens_by_param) {
276 339         516 my $code = join '', map { $_->content } @$tokens;
  1438         4123  
277 339 100       3116 next unless $code =~ /\S/;
278              
279 336         1116 DEBUG( "raw_parameter: $code\n" );
280              
281 336         956 $self->_strip_ws($_) for ($code);
282              
283 336         563 my $first_significant_token = _first_significant_token($tokens);
284              
285 336         1265 my $param = Method::Signatures::Parameter->new(
286             original_code => $code,
287             position => $idx,
288             first_line_number => $first_significant_token->line_number,
289             );
290              
291 334 100       1168 $idx++ if $param->is_positional;
292              
293 334         676 push @params, $param;
294             }
295              
296 205         1578 return \@params;
297             }
298              
299              
300             sub _all_tokens_in_listref_are_whitespace {
301 3     3   29 my $listref = shift;
302 3     4   22 return all { $_->class eq 'PPI::Token::Whitespace' } @$listref;
  4         10  
303             }
304              
305              
306             sub _first_significant_token {
307 336     336   350 my $tokens = shift;
308              
309 336         427 for my $token (@$tokens) {
310 480 100       1346 return $token if $token->significant;
311             }
312              
313 0           croak "No significant token found";
314             }
315              
316             1;