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 63     63   13103 use Carp;
  63         70  
  63         3221  
4 63     63   637 use Mouse;
  63         19814  
  63         278  
5 63     63   33297 use Method::Signatures::Types;
  63         103  
  63         1401  
6 63     63   594 use Method::Signatures::Parameter;
  63         66  
  63         1183  
7 63     63   189 use Method::Signatures::Utils qw(new_ppi_doc sig_parsing_error DEBUG);
  63         56  
  63         3215  
8 63     63   280 use List::Util qw(all);
  63         57  
  63         74094  
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 673     673 0 472 return scalar @{$_[0]->named_parameters};
  673         1871  
75             }
76              
77             sub num_positional {
78 400     400 0 289 return scalar @{$_[0]->positional_parameters};
  400         1741  
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 179     179 0 158 return scalar @{$_[0]->optional_positional_parameters};
  179         936  
87             }
88              
89             sub num_slurpy {
90 487     487 0 348 return scalar @{$_[0]->slurpy_parameters};
  487         1446  
91             }
92              
93             sub num_yadayada {
94 52     52 0 98 return scalar @{$_[0]->yadayada_parameters};
  52         462  
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 246     246 1 285 my $self = shift;
142              
143 246         346 for my $sig (@{$self->parameters}) {
  246         940  
144             # Handle "don't care" specifier
145 338 100       760 if ($sig->is_yadayada) {
146 6         7 push @{$self->slurpy_parameters}, $sig;
  6         14  
147 6         7 push @{$self->yadayada_parameters}, $sig;
  6         15  
148 6         10 next;
149             }
150              
151 332 100       1208 $sig->check($self) unless $self->no_checks;
152              
153 320 100       628 push @{$self->named_parameters}, $sig if $sig->is_named;
  47         95  
154 320 100       527 push @{$self->positional_parameters}, $sig if $sig->is_positional;
  273         545  
155 320 100       668 push @{$self->optional_parameters}, $sig if $sig->is_optional;
  176         319  
156 320 100 100     596 push @{$self->optional_positional_parameters}, $sig
  133         238  
157             if $sig->is_optional and $sig->is_positional;
158 320 100       687 push @{$self->slurpy_parameters}, $sig if $sig->is_slurpy;
  30         63  
159              
160 320         685 DEBUG( "sig: ", $sig );
161             }
162              
163 232         457 $self->_calculate_max_args;
164 232 100       714 $self->check unless $self->no_checks;
165              
166 229         703 return;
167             }
168              
169              
170             sub _calculate_max_args {
171 232     232   217 my $self = shift;
172              
173             # If there's a slurpy argument, the max is infinity.
174 232 100       395 if( $self->num_slurpy ) {
175 32         174 $self->max_argv_size($INF);
176 32         91 $self->max_args($INF);
177              
178 32         35 return;
179             }
180              
181 200         362 $self->max_argv_size( ($self->num_named * 2) + $self->num_positional );
182 200         337 $self->max_args( $self->num_named + $self->num_positional );
183              
184 200         224 return;
185             }
186              
187              
188             # Check the integrity of the signature as a whole
189             sub check {
190 217     217 0 226 my $self = shift;
191              
192             # Check that slurpy arguments come at the end
193 217 100 100     279 if(
      100        
194             $self->num_slurpy &&
195             !($self->num_yadayada || $self->positional_parameters->[-1]->is_slurpy)
196             )
197             {
198 3         7 my $slurpy_param = $self->slurpy_parameters->[0];
199 3         4 sig_parsing_error("Slurpy parameter '@{[$slurpy_param->variable]}' must come at the end");
  3         20  
200             }
201              
202 214         242 return 1;
203             }
204              
205              
206             sub _strip_ws {
207 341     341   748 $_[1] =~ s/^\s+//;
208 341         901 $_[1] =~ s/\s+$//;
209             }
210              
211              
212             my $IDENTIFIER = qr{ [^\W\d] \w* }x;
213             sub _build_parameter_string {
214 246     246   236 my $self = shift;
215              
216 246         430 my $sig_string = $self->signature_string;
217 246         239 my $invocant;
218              
219             # Extract an invocant, if one is present.
220 246 100       3980 if ($sig_string =~ s{ ^ \s* (\$ $IDENTIFIER) \s* : \s* }{}x) {
221 13         53 $self->invocant($1);
222             }
223              
224             # The siganture, minus the invocant, is just the list of parameters
225 246         817 return $sig_string;
226             }
227              
228              
229             sub _build_parameters {
230 246     246   226 my $self = shift;
231              
232 246         756 my $param_string = $self->parameter_string;
233 246 100       868 return [] unless $param_string =~ /\S/;
234              
235 210         634 my $ppi = $self->ppi_doc;
236 210         835 $ppi->prune('PPI::Token::Comment');
237              
238 210         75834 my $statement = $ppi->find_first("PPI::Statement");
239 210 50       29346 sig_parsing_error("Could not understand parameter list specification: $param_string")
240             unless $statement;
241 210         820 my $token = $statement->first_token;
242              
243             # Split the signature into parameters as tokens.
244 210         2350 my @tokens_by_param = ([]);
245 210         288 do {
246 1579 100 100     21875 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         20 my $bare_dollar_token = PPI::Token::Cast->new('$');
253 2         19 $token->insert_after($bare_dollar_token);
254 2         98 $bare_dollar_token->insert_after(PPI::Token::Operator->new(','));
255 2         65 $token->remove;
256 2         49 $token = $bare_dollar_token;
257             }
258              
259 1579 100 100     5640 if( $token->class eq "PPI::Token::Operator" and $token->content eq ',' )
260             {
261 134         939 push @tokens_by_param, [];
262             }
263             else {
264 1445         4450 push @{$tokens_by_param[-1]}, $token;
  1445         1856  
265             }
266              
267             # "Type: $arg" is interpreted by PPI as a label, which is lucky for us.
268 1579 100       2175 $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 210         3286 my $idx = 0;
274 210         226 my @params;
275 210         384 for my $tokens (@tokens_by_param) {
276 344         520 my $code = join '', map { $_->content } @$tokens;
  1445         4369  
277 344 100       3844 next unless $code =~ /\S/;
278              
279 341         1117 DEBUG( "raw_parameter: $code\n" );
280              
281 341         946 $self->_strip_ws($_) for ($code);
282              
283 341         542 my $first_significant_token = _first_significant_token($tokens);
284              
285 341         1112 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 339 100       1150 $idx++ if $param->is_positional;
292              
293 339         669 push @params, $param;
294             }
295              
296 208         1644 return \@params;
297             }
298              
299              
300             sub _all_tokens_in_listref_are_whitespace {
301 3     3   30 my $listref = shift;
302 3     4   29 return all { $_->class eq 'PPI::Token::Whitespace' } @$listref;
  4         12  
303             }
304              
305              
306             sub _first_significant_token {
307 341     341   316 my $tokens = shift;
308              
309 341         430 for my $token (@$tokens) {
310 487 100       1306 return $token if $token->significant;
311             }
312              
313 0           croak "No significant token found";
314             }
315              
316             1;