line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Parse::Method::Signatures; |
2
|
|
|
|
|
|
|
|
3
|
3
|
|
|
3
|
|
866892
|
use Moose; |
|
3
|
|
|
|
|
672168
|
|
|
3
|
|
|
|
|
19
|
|
4
|
3
|
|
|
|
|
32
|
use MooseX::Types::Moose qw/ |
5
|
|
|
|
|
|
|
ArrayRef HashRef ScalarRef CodeRef Int Str ClassName |
6
|
3
|
|
|
3
|
|
16809
|
/; |
|
3
|
|
|
|
|
103644
|
|
7
|
|
|
|
|
|
|
|
8
|
3
|
|
|
3
|
|
13683
|
use Class::Load qw(load_class); |
|
3
|
|
|
|
|
4
|
|
|
3
|
|
|
|
|
160
|
|
9
|
3
|
|
|
3
|
|
1680
|
use PPI; |
|
3
|
|
|
|
|
296910
|
|
|
3
|
|
|
|
|
107
|
|
10
|
3
|
|
|
3
|
|
23
|
use Moose::Util::TypeConstraints; |
|
3
|
|
|
|
|
3
|
|
|
3
|
|
|
|
|
34
|
|
11
|
3
|
|
|
3
|
|
6062
|
use Parse::Method::Signatures::ParamCollection; |
|
3
|
|
|
|
|
9
|
|
|
3
|
|
|
|
|
123
|
|
12
|
3
|
|
|
|
|
14
|
use Parse::Method::Signatures::Types qw/ |
13
|
|
|
|
|
|
|
PositionalParam NamedParam UnpackedParam |
14
|
3
|
|
|
3
|
|
19
|
/; |
|
3
|
|
|
|
|
4
|
|
15
|
|
|
|
|
|
|
|
16
|
3
|
|
|
3
|
|
4884
|
use Carp qw/croak/; |
|
3
|
|
|
|
|
4
|
|
|
3
|
|
|
|
|
202
|
|
17
|
|
|
|
|
|
|
|
18
|
3
|
|
|
3
|
|
11
|
use namespace::clean -except => 'meta'; |
|
3
|
|
|
|
|
4
|
|
|
3
|
|
|
|
|
16
|
|
19
|
|
|
|
|
|
|
our $VERSION = '1.003017'; |
20
|
|
|
|
|
|
|
our $ERROR_LEVEL = 0; |
21
|
|
|
|
|
|
|
our %LEXTABLE; |
22
|
|
|
|
|
|
|
our $DEBUG = $ENV{PMS_DEBUG} || 0; |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
# Setup what we need for specific PPI subclasses |
25
|
|
|
|
|
|
|
@PPI::Token::EOF::ISA = 'PPI::Token'; |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
class_type "PPI::Document"; |
28
|
|
|
|
|
|
|
class_type "PPI::Element"; |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
has 'input' => ( |
31
|
|
|
|
|
|
|
is => 'ro', |
32
|
|
|
|
|
|
|
isa => Str, |
33
|
|
|
|
|
|
|
required => 1 |
34
|
|
|
|
|
|
|
); |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
has 'offset' => ( |
37
|
|
|
|
|
|
|
is => 'rw', |
38
|
|
|
|
|
|
|
isa => Int, |
39
|
|
|
|
|
|
|
default => 0, |
40
|
|
|
|
|
|
|
); |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
has 'signature_class' => ( |
43
|
|
|
|
|
|
|
is => 'ro', |
44
|
|
|
|
|
|
|
isa => Str, |
45
|
|
|
|
|
|
|
default => 'Parse::Method::Signatures::Sig', |
46
|
|
|
|
|
|
|
); |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
has 'param_class' => ( |
49
|
|
|
|
|
|
|
is => 'ro', |
50
|
|
|
|
|
|
|
isa => Str, |
51
|
|
|
|
|
|
|
default => 'Parse::Method::Signatures::Param', |
52
|
|
|
|
|
|
|
); |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
has 'type_constraint_class' => ( |
55
|
|
|
|
|
|
|
is => 'ro', |
56
|
|
|
|
|
|
|
isa => Str, |
57
|
|
|
|
|
|
|
default => 'Parse::Method::Signatures::TypeConstraint', |
58
|
|
|
|
|
|
|
); |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
has 'type_constraint_callback' => ( |
61
|
|
|
|
|
|
|
is => 'ro', |
62
|
|
|
|
|
|
|
isa => CodeRef, |
63
|
|
|
|
|
|
|
predicate => 'has_type_constraint_callback', |
64
|
|
|
|
|
|
|
); |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
has 'from_namespace' => ( |
67
|
|
|
|
|
|
|
is => 'rw', |
68
|
|
|
|
|
|
|
isa => ClassName, |
69
|
|
|
|
|
|
|
predicate => 'has_from_namespace' |
70
|
|
|
|
|
|
|
); |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
has 'ppi_doc' => ( |
73
|
|
|
|
|
|
|
is => 'ro', |
74
|
|
|
|
|
|
|
isa => 'PPI::Document', |
75
|
|
|
|
|
|
|
lazy_build => 1, |
76
|
|
|
|
|
|
|
builder => 'parse', |
77
|
|
|
|
|
|
|
); |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
# A bit dirty, but we set this with local most of the time |
80
|
|
|
|
|
|
|
has 'ppi' => ( |
81
|
|
|
|
|
|
|
is => 'ro', |
82
|
|
|
|
|
|
|
isa => 'PPI::Element', |
83
|
|
|
|
|
|
|
lazy_build => 1, |
84
|
|
|
|
|
|
|
writer => '_set_ppi' |
85
|
|
|
|
|
|
|
); |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
sub BUILD { |
88
|
147
|
|
|
147
|
0
|
255
|
my ($self) = @_; |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
load_class($_) |
91
|
147
|
|
|
|
|
267
|
for map { $self->$_ } qw/ |
|
441
|
|
|
|
|
12317
|
|
92
|
|
|
|
|
|
|
signature_class |
93
|
|
|
|
|
|
|
param_class |
94
|
|
|
|
|
|
|
type_constraint_class |
95
|
|
|
|
|
|
|
/; |
96
|
|
|
|
|
|
|
|
97
|
147
|
|
|
|
|
12443
|
my $ppi = $self->ppi; |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
# Skip leading whitespace |
100
|
147
|
50
|
|
|
|
4112
|
$self->consume_token |
101
|
|
|
|
|
|
|
unless $ppi->significant; |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
sub create_param { |
105
|
206
|
|
|
206
|
0
|
267
|
my ($self, $args) = @_; |
106
|
|
|
|
|
|
|
|
107
|
206
|
|
|
|
|
315
|
my @traits; |
108
|
|
|
|
|
|
|
push @traits, $args->{ variable_name } ? 'Bindable' : 'Placeholder' |
109
|
206
|
100
|
|
|
|
930
|
if !exists $args->{unpacking}; |
|
|
100
|
|
|
|
|
|
110
|
206
|
100
|
|
|
|
577
|
push @traits, $args->{ named } ? 'Named' : 'Positional'; |
111
|
|
|
|
|
|
|
push @traits, 'Unpacked::' . $args->{unpacking} |
112
|
206
|
100
|
|
|
|
488
|
if exists $args->{unpacking}; |
113
|
|
|
|
|
|
|
|
114
|
206
|
|
|
|
|
5638
|
return $self->param_class->new_with_traits(traits => \@traits, %{ $args }); |
|
206
|
|
|
|
|
1377
|
|
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
override BUILDARGS => sub { |
118
|
|
|
|
|
|
|
my $class = shift; |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
return { input => $_[0] } if @_ == 1 and !ref $_[0]; |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
return super(); |
123
|
|
|
|
|
|
|
}; |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
sub parse { |
126
|
147
|
|
|
147
|
0
|
223
|
my ($self) = @_; |
127
|
|
|
|
|
|
|
|
128
|
147
|
|
|
|
|
3810
|
my $input = substr($self->input, $self->offset); |
129
|
147
|
|
|
|
|
1083
|
my $doc = PPI::Document->new(\$input); |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
# Append the magic EOF Token |
132
|
147
|
|
|
|
|
179705
|
$doc->add_element(PPI::Token::EOF->new("")); |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
# Annoyingly "m($x)" gets treated as a regex operator. This isn't what we |
135
|
|
|
|
|
|
|
# want. so replace it with a Word, then a list. The way we do this is by |
136
|
|
|
|
|
|
|
# taking the operator off the front, then reparsing the rest of the content |
137
|
|
|
|
|
|
|
# This will look the same (so wont affect anything in a code block) but is |
138
|
|
|
|
|
|
|
# just store different token wise. |
139
|
147
|
|
|
|
|
3407
|
$self->_replace_regexps($doc); |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
# ($, $x) parses the $, as a single var. not what we want. FIX UP |
142
|
|
|
|
|
|
|
# While we're att it lets fixup $: $? and $! |
143
|
147
|
|
|
|
|
62753
|
$self->_replace_magic($doc); |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
# (Str :$x) yields a label of "Str :" |
146
|
|
|
|
|
|
|
# (Foo Bar :$x) yields a label of "Bar :" |
147
|
147
|
|
|
|
|
48501
|
$self->_replace_labels($doc); |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
# This one is actually a bug in PPI, rather than just an oddity |
150
|
|
|
|
|
|
|
# (Str $x = 0xfF) parses as "Oxf" and a word of "F" |
151
|
147
|
|
|
|
|
51236
|
$self->_fixup_hex($doc); |
152
|
|
|
|
|
|
|
|
153
|
147
|
|
|
|
|
57078
|
return $doc; |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
sub _replace_regexps { |
157
|
147
|
|
|
147
|
|
247
|
my ($self, $doc) = @_; |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
REGEXP: |
160
|
147
|
100
|
|
|
|
197
|
foreach my $node ( @{ $doc->find('Token::Regexp') || [] } ) { |
|
147
|
|
|
|
|
463
|
|
161
|
2
|
|
|
|
|
812
|
my $str = $node->content; |
162
|
|
|
|
|
|
|
|
163
|
2
|
100
|
|
|
|
16
|
next REGEXP unless defined $node->{operator}; |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
# Rather annoyingly, there are *no* methods on Token::Regexp; |
166
|
1
|
|
|
|
|
3
|
my ($word, $rest) = $str =~ /^(\Q@{[$node->{operator}]}\E)(.*)$/s; |
|
1
|
|
|
|
|
17
|
|
167
|
|
|
|
|
|
|
|
168
|
1
|
|
|
|
|
4
|
my $subdoc = PPI::Document->new(\$rest); |
169
|
1
|
|
|
|
|
679
|
my @to_add = reverse map { $_->remove } $subdoc->children; |
|
1
|
|
|
|
|
11
|
|
170
|
1
|
|
|
|
|
38
|
push @to_add, new PPI::Token::Word($word); |
171
|
|
|
|
|
|
|
# insert_after restricts what you can insert. |
172
|
|
|
|
|
|
|
# $node->insert_after($_) for @to_add; |
173
|
1
|
|
|
|
|
11
|
$node->__insert_after($_) for @to_add; |
174
|
|
|
|
|
|
|
|
175
|
1
|
|
|
|
|
40
|
$node->delete; |
176
|
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
sub _replace_magic { |
181
|
147
|
|
|
147
|
|
262
|
my ($self, $doc) = @_; |
182
|
|
|
|
|
|
|
|
183
|
147
|
100
|
|
|
|
205
|
foreach my $node ( @{ $doc->find('Token::Magic') || [] } ) { |
|
147
|
|
|
|
|
467
|
|
184
|
17
|
100
|
|
|
|
6991
|
my ($op) = $node->content =~ /^\$([,?:!)])$/ or next; |
185
|
|
|
|
|
|
|
|
186
|
7
|
|
|
|
|
68
|
$node->insert_after(new PPI::Token::Operator($op)); |
187
|
7
|
|
|
|
|
346
|
$node->insert_after(new PPI::Token::Cast('$')); |
188
|
7
|
|
|
|
|
275
|
$node->delete; |
189
|
|
|
|
|
|
|
} |
190
|
|
|
|
|
|
|
} |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
sub _replace_labels { |
193
|
147
|
|
|
147
|
|
251
|
my ($self, $doc) = @_; |
194
|
|
|
|
|
|
|
|
195
|
147
|
100
|
|
|
|
175
|
foreach my $node ( @{ $doc->find('Token::Label') || [] } ) { |
|
147
|
|
|
|
|
405
|
|
196
|
8
|
50
|
|
|
|
3457
|
my ($word, $ws) = $node->content =~ /^(.*?)(\s+)?:$/s or next; |
197
|
|
|
|
|
|
|
|
198
|
8
|
|
|
|
|
110
|
$node->insert_after(new PPI::Token::Operator(':')); |
199
|
8
|
100
|
|
|
|
434
|
$node->insert_after(new PPI::Token::Whitespace($ws)) if defined $ws; |
200
|
8
|
|
|
|
|
178
|
$node->insert_after(new PPI::Token::Word($word)); |
201
|
8
|
|
|
|
|
197
|
$node->delete; |
202
|
|
|
|
|
|
|
} |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
sub _fixup_hex { |
206
|
147
|
|
|
147
|
|
252
|
my ($self, $doc) = @_; |
207
|
|
|
|
|
|
|
|
208
|
147
|
100
|
|
|
|
195
|
foreach my $node ( @{ $doc->find('Token::Number::Hex') || [] } ) { |
|
147
|
|
|
|
|
316
|
|
209
|
3
|
|
|
|
|
1046
|
my $next = $node->next_token; |
210
|
3
|
50
|
66
|
|
|
157
|
next unless $next->isa('PPI::Token::Word') |
211
|
|
|
|
|
|
|
&& $next->content =~ /^[0-9a-f]+$/i; |
212
|
|
|
|
|
|
|
|
213
|
0
|
|
|
|
|
0
|
$node->add_content($next->content); |
214
|
0
|
|
|
|
|
0
|
$next->delete; |
215
|
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
sub _build_ppi { |
219
|
147
|
|
|
147
|
|
241
|
my ($self) = @_; |
220
|
147
|
|
|
|
|
3830
|
my $ppi = $self->ppi_doc->first_token; |
221
|
|
|
|
|
|
|
|
222
|
147
|
100
|
100
|
|
|
3603
|
if ($ppi->class eq 'PPI::Token::Word' && exists $LEXTABLE{"$ppi"}) { |
223
|
1
|
|
|
|
|
11
|
bless $ppi, "PPI::Token::LexSymbol"; |
224
|
1
|
|
|
|
|
53
|
$ppi->{lex} = $LEXTABLE{"$ppi"}; |
225
|
|
|
|
|
|
|
} |
226
|
147
|
|
|
|
|
4548
|
return $ppi; |
227
|
|
|
|
|
|
|
} |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
# signature: O_PAREN |
230
|
|
|
|
|
|
|
# invocant |
231
|
|
|
|
|
|
|
# params |
232
|
|
|
|
|
|
|
# C_PAREN |
233
|
|
|
|
|
|
|
# |
234
|
|
|
|
|
|
|
# invocant: param ':' |
235
|
|
|
|
|
|
|
# |
236
|
|
|
|
|
|
|
# params: param COMMA params |
237
|
|
|
|
|
|
|
# | param |
238
|
|
|
|
|
|
|
# | /* NUL */ |
239
|
|
|
|
|
|
|
sub signature { |
240
|
120
|
|
|
120
|
1
|
33517
|
my $self = shift; |
241
|
|
|
|
|
|
|
|
242
|
120
|
100
|
|
|
|
4181
|
$self = $self->new(@_) unless blessed($self); |
243
|
|
|
|
|
|
|
|
244
|
120
|
|
|
|
|
388
|
$self->assert_token('('); |
245
|
|
|
|
|
|
|
|
246
|
120
|
|
|
|
|
203
|
my $args = {}; |
247
|
120
|
|
|
|
|
160
|
my $params = []; |
248
|
|
|
|
|
|
|
|
249
|
120
|
|
|
|
|
370
|
my $param = $self->param; |
250
|
|
|
|
|
|
|
|
251
|
108
|
100
|
100
|
|
|
3497
|
if ($param && $self->ppi->content eq ':') { |
252
|
|
|
|
|
|
|
# That param was actually the invocant |
253
|
13
|
|
|
|
|
119
|
$args->{invocant} = $param; |
254
|
13
|
100
|
|
|
|
67
|
croak "Invocant cannot be named" |
255
|
|
|
|
|
|
|
if NamedParam->check($param); |
256
|
12
|
100
|
|
|
|
11568
|
croak "Invocant cannot be optional" |
257
|
|
|
|
|
|
|
if !$param->required; |
258
|
11
|
100
|
|
|
|
395
|
croak "Invocant cannot have a default value" |
259
|
|
|
|
|
|
|
if $param->has_default_value; |
260
|
|
|
|
|
|
|
|
261
|
10
|
100
|
66
|
|
|
36
|
croak "Invocant must be a simple scalar" |
262
|
|
|
|
|
|
|
if UnpackedParam->check($param) || $param->sigil ne '$'; |
263
|
|
|
|
|
|
|
|
264
|
7
|
|
|
|
|
32
|
$self->consume_token; |
265
|
7
|
|
|
|
|
21
|
$param = $self->param; |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
} |
268
|
|
|
|
|
|
|
|
269
|
102
|
100
|
|
|
|
843
|
if ($param) { |
270
|
95
|
|
|
|
|
277
|
push @$params, $param; |
271
|
|
|
|
|
|
|
|
272
|
95
|
100
|
|
|
|
3152
|
my $greedy = $param->sigil ne '$' ? $param : undef; |
273
|
95
|
|
|
|
|
3168
|
my $opt_pos_param = !$param->required; |
274
|
|
|
|
|
|
|
|
275
|
95
|
|
|
|
|
2489
|
while ($self->ppi->content eq ',') { |
276
|
42
|
|
|
|
|
322
|
$self->consume_token; |
277
|
|
|
|
|
|
|
|
278
|
42
|
|
|
|
|
1098
|
my $err_ctx = $self->ppi; |
279
|
42
|
|
|
|
|
118
|
$param = $self->param; |
280
|
42
|
100
|
|
|
|
178
|
$self->error($err_ctx, "Parameter expected") |
281
|
|
|
|
|
|
|
if !$param; |
282
|
|
|
|
|
|
|
|
283
|
41
|
|
|
|
|
196
|
my $is_named = NamedParam->check($param); |
284
|
41
|
100
|
|
|
|
38897
|
if (!$is_named) { |
285
|
26
|
100
|
100
|
|
|
926
|
if ($param->required && $opt_pos_param) { |
286
|
1
|
|
|
|
|
7
|
$self->error($err_ctx, "Invalid: Required positional param " . |
287
|
|
|
|
|
|
|
" found after optional one"); |
288
|
|
|
|
|
|
|
} |
289
|
25
|
100
|
|
|
|
90
|
if ($greedy) { |
290
|
4
|
|
|
|
|
135
|
croak "Invalid: Un-named parameter '" . $param->variable_name |
291
|
|
|
|
|
|
|
. "' after greedy '" |
292
|
|
|
|
|
|
|
. $greedy->variable_name . "'\n"; |
293
|
|
|
|
|
|
|
} |
294
|
|
|
|
|
|
|
} |
295
|
|
|
|
|
|
|
|
296
|
36
|
|
|
|
|
102
|
push @$params, $param; |
297
|
36
|
|
100
|
|
|
875
|
$opt_pos_param = $opt_pos_param || !$param->required; |
298
|
36
|
100
|
|
|
|
1101
|
$greedy = $param->sigil ne '$' ? $param : undef; |
299
|
|
|
|
|
|
|
} |
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
|
302
|
96
|
|
|
|
|
733
|
$self->assert_token(')'); |
303
|
87
|
|
|
|
|
236
|
$args->{params} = $params; |
304
|
|
|
|
|
|
|
|
305
|
87
|
|
|
|
|
2537
|
my $sig = $self->signature_class->new($args); |
306
|
|
|
|
|
|
|
|
307
|
87
|
|
|
|
|
2636
|
return $sig; |
308
|
|
|
|
|
|
|
} |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
# param: tc? |
312
|
|
|
|
|
|
|
# var |
313
|
|
|
|
|
|
|
# (OPTIONAL|REQUIRED)? |
314
|
|
|
|
|
|
|
# default? |
315
|
|
|
|
|
|
|
# where* |
316
|
|
|
|
|
|
|
# trait* |
317
|
|
|
|
|
|
|
# |
318
|
|
|
|
|
|
|
# where: WHERE <code block> |
319
|
|
|
|
|
|
|
# |
320
|
|
|
|
|
|
|
# trait: TRAIT class |
321
|
|
|
|
|
|
|
# |
322
|
|
|
|
|
|
|
# var : COLON label '(' var_or_unpack ')' # label is classish, with only /a-z0-9_/i allowed |
323
|
|
|
|
|
|
|
# | COLON VAR |
324
|
|
|
|
|
|
|
# | var_or_unpack |
325
|
|
|
|
|
|
|
# |
326
|
|
|
|
|
|
|
# var_or_unpack : '[' param* ']' # should all be required + un-named |
327
|
|
|
|
|
|
|
# | '{' param* '}' # Should all be named |
328
|
|
|
|
|
|
|
# | VAR |
329
|
|
|
|
|
|
|
# |
330
|
|
|
|
|
|
|
# OPTIONAL: '?' |
331
|
|
|
|
|
|
|
# REQUIRED: '!' |
332
|
|
|
|
|
|
|
sub param { |
333
|
232
|
|
|
232
|
1
|
620
|
my $self = shift; |
334
|
232
|
|
|
|
|
251
|
my $class_meth; |
335
|
232
|
100
|
|
|
|
865
|
unless (blessed($self)) { |
336
|
2
|
50
|
|
|
|
81
|
$self = $self->new(@_) unless blessed($self); |
337
|
2
|
|
|
|
|
4
|
$class_meth = 1; |
338
|
|
|
|
|
|
|
} |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
# Also used to check if a anything has been consumed |
341
|
232
|
|
|
|
|
5606
|
my $err_ctx = $self->ppi; |
342
|
|
|
|
|
|
|
|
343
|
232
|
|
|
|
|
678
|
my $param = { |
344
|
|
|
|
|
|
|
required => 1, |
345
|
|
|
|
|
|
|
}; |
346
|
|
|
|
|
|
|
|
347
|
232
|
|
|
|
|
675
|
$self->_param_typed($param); |
348
|
|
|
|
|
|
|
|
349
|
230
|
50
|
66
|
|
|
704
|
$self->_param_opt_or_req( |
|
|
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
350
|
|
|
|
|
|
|
$self->_param_labeled($param) |
351
|
|
|
|
|
|
|
|| $self->_param_named($param) |
352
|
|
|
|
|
|
|
|| $self->_param_variable($param) |
353
|
|
|
|
|
|
|
|| $self->_unpacked_param($param) |
354
|
|
|
|
|
|
|
) or ($err_ctx == $self->ppi and return) |
355
|
|
|
|
|
|
|
or $self->error($err_ctx); |
356
|
|
|
|
|
|
|
|
357
|
209
|
|
|
|
|
667
|
$self->_param_default($param); |
358
|
209
|
|
|
|
|
1139
|
$self->_param_constraint_or_traits($param); |
359
|
|
|
|
|
|
|
|
360
|
206
|
|
|
|
|
804
|
$param = $self->create_param($param); |
361
|
|
|
|
|
|
|
|
362
|
206
|
50
|
|
|
|
262792
|
return !$class_meth |
|
|
100
|
|
|
|
|
|
363
|
|
|
|
|
|
|
? $param |
364
|
|
|
|
|
|
|
: wantarray |
365
|
|
|
|
|
|
|
? ($param, $self->remaining_input) |
366
|
|
|
|
|
|
|
: $param; |
367
|
|
|
|
|
|
|
} |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
sub _param_opt_or_req { |
370
|
219
|
|
|
219
|
|
509
|
my ($self, $param) = @_; |
371
|
|
|
|
|
|
|
|
372
|
219
|
100
|
|
|
|
756
|
return unless $param; |
373
|
|
|
|
|
|
|
|
374
|
209
|
100
|
|
|
|
5145
|
if ($self->ppi->class eq 'PPI::Token::Operator') { |
375
|
115
|
|
|
|
|
3061
|
my $c = $self->ppi->content; |
376
|
115
|
100
|
|
|
|
679
|
if ($c eq '?') { |
|
|
100
|
|
|
|
|
|
377
|
9
|
|
|
|
|
22
|
$param->{required} = 0; |
378
|
9
|
|
|
|
|
21
|
$self->consume_token; |
379
|
|
|
|
|
|
|
} elsif ($c eq '!') { |
380
|
7
|
|
|
|
|
15
|
$param->{required} = 1; |
381
|
7
|
|
|
|
|
15
|
$self->consume_token; |
382
|
|
|
|
|
|
|
} |
383
|
|
|
|
|
|
|
} |
384
|
209
|
|
|
|
|
817
|
return $param; |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
} |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
sub _param_constraint_or_traits { |
389
|
209
|
|
|
209
|
|
345
|
my ($self, $param) = @_; |
390
|
|
|
|
|
|
|
|
391
|
209
|
|
100
|
|
|
651
|
while ($self->_param_where($param) || |
392
|
|
|
|
|
|
|
$self->_param_traits($param) ) { |
393
|
|
|
|
|
|
|
# No op; |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
} |
396
|
206
|
|
|
|
|
231
|
return $param; |
397
|
|
|
|
|
|
|
} |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
sub _param_where { |
400
|
228
|
|
|
228
|
|
258
|
my ($self, $param) = @_; |
401
|
|
|
|
|
|
|
|
402
|
228
|
100
|
100
|
|
|
5460
|
return unless $self->ppi->isa('PPI::Token::LexSymbol') |
403
|
|
|
|
|
|
|
&& $self->ppi->lex eq 'WHERE'; |
404
|
|
|
|
|
|
|
|
405
|
13
|
|
|
|
|
30
|
$self->consume_token; |
406
|
|
|
|
|
|
|
|
407
|
13
|
|
100
|
|
|
61
|
$param->{constraints} ||= []; |
408
|
|
|
|
|
|
|
|
409
|
13
|
|
|
|
|
310
|
my $ppi = $self->ppi; |
410
|
|
|
|
|
|
|
|
411
|
13
|
100
|
66
|
|
|
52
|
$self->error($ppi, "Block expected after where") |
412
|
|
|
|
|
|
|
unless $ppi->class eq 'PPI::Token::Structure' |
413
|
|
|
|
|
|
|
&& $ppi->content eq '{'; |
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
# Go from token to block |
416
|
12
|
|
|
|
|
116
|
$ppi = $ppi->parent; |
417
|
|
|
|
|
|
|
|
418
|
12
|
100
|
|
|
|
58
|
$ppi->finish or $self->error($ppi, |
419
|
|
|
|
|
|
|
"Runaway '" . $ppi->braces . "' in " . $self->_parsing_area(1), 1); |
420
|
|
|
|
|
|
|
|
421
|
11
|
|
|
|
|
47
|
push @{$param->{constraints}}, $ppi->content; |
|
11
|
|
|
|
|
43
|
|
422
|
|
|
|
|
|
|
|
423
|
11
|
|
|
|
|
463
|
$self->_set_ppi($ppi->finish); |
424
|
11
|
|
|
|
|
19
|
$self->consume_token; |
425
|
11
|
|
|
|
|
38
|
return $param; |
426
|
|
|
|
|
|
|
} |
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
sub _param_traits { |
429
|
215
|
|
|
215
|
|
305
|
my ($self, $param) = @_; |
430
|
215
|
100
|
66
|
|
|
5155
|
return unless $self->ppi->isa('PPI::Token::LexSymbol') |
431
|
|
|
|
|
|
|
&& $self->ppi->lex eq 'TRAIT'; |
432
|
|
|
|
|
|
|
|
433
|
9
|
|
|
|
|
22
|
my $op = $self->consume_token->content; |
434
|
|
|
|
|
|
|
|
435
|
9
|
100
|
|
|
|
235
|
$self->error($self->ppi, "Error parsing parameter trait") |
436
|
|
|
|
|
|
|
unless $self->ppi->isa('PPI::Token::Word'); |
437
|
|
|
|
|
|
|
|
438
|
8
|
|
100
|
|
|
43
|
$param->{param_traits} ||= []; |
439
|
|
|
|
|
|
|
|
440
|
8
|
|
|
|
|
10
|
push @{$param->{param_traits}}, [$op, $self->consume_token->content]; |
|
8
|
|
|
|
|
18
|
|
441
|
8
|
|
|
|
|
53
|
return $param; |
442
|
|
|
|
|
|
|
} |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
sub _param_labeled { |
445
|
230
|
|
|
230
|
|
298
|
my ($self, $param) = @_; |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
return unless |
448
|
230
|
100
|
100
|
|
|
5561
|
$self->ppi->content eq ':' && |
449
|
|
|
|
|
|
|
$self->ppi->next_token->isa('PPI::Token::Word'); |
450
|
|
|
|
|
|
|
|
451
|
14
|
|
|
|
|
394
|
$self->consume_token; |
452
|
|
|
|
|
|
|
|
453
|
14
|
50
|
|
|
|
342
|
$self->error($self->ppi, "Invalid label") |
454
|
|
|
|
|
|
|
if $self->ppi->content =~ /[^-\w]/; |
455
|
|
|
|
|
|
|
|
456
|
14
|
|
|
|
|
81
|
$param->{named} = 1; |
457
|
14
|
|
|
|
|
26
|
$param->{required} = 0; |
458
|
14
|
|
|
|
|
29
|
$param->{label} = $self->consume_token->content; |
459
|
|
|
|
|
|
|
|
460
|
14
|
|
|
|
|
66
|
$self->assert_token('('); |
461
|
14
|
100
|
100
|
|
|
39
|
$self->_unpacked_param($param) |
462
|
|
|
|
|
|
|
|| $self->_param_variable($param) |
463
|
|
|
|
|
|
|
|| $self->error($self->ppi); |
464
|
|
|
|
|
|
|
|
465
|
9
|
|
|
|
|
69
|
$self->assert_token(')'); |
466
|
|
|
|
|
|
|
|
467
|
9
|
|
|
|
|
51
|
return $param; |
468
|
|
|
|
|
|
|
} |
469
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
sub _unpacked_param { |
471
|
38
|
|
|
38
|
|
64
|
my ($self, $param) = @_; |
472
|
|
|
|
|
|
|
|
473
|
38
|
|
100
|
|
|
147
|
return $self->bracketed('[', \&unpacked_array, $param) || |
474
|
|
|
|
|
|
|
$self->bracketed('{', \&unpacked_hash, $param); |
475
|
|
|
|
|
|
|
} |
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
sub _param_named { |
478
|
216
|
|
|
216
|
|
2838
|
my ($self, $param) = @_; |
479
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
return unless |
481
|
216
|
100
|
100
|
|
|
5167
|
$self->ppi->content eq ':' && |
482
|
|
|
|
|
|
|
$self->ppi->next_token->isa('PPI::Token::Symbol'); |
483
|
|
|
|
|
|
|
|
484
|
45
|
|
|
|
|
834
|
$param->{required} = 0; |
485
|
45
|
|
|
|
|
103
|
$param->{named} = 1; |
486
|
45
|
|
|
|
|
122
|
$self->consume_token; |
487
|
|
|
|
|
|
|
|
488
|
45
|
|
|
|
|
1092
|
my $err_ctx = $self->ppi; |
489
|
45
|
|
|
|
|
134
|
$param = $self->_param_variable($param); |
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
$self->error($err_ctx, "Arrays or hashes cannot be named") |
492
|
45
|
100
|
|
|
|
166
|
if $param->{sigil} ne '$'; |
493
|
|
|
|
|
|
|
|
494
|
42
|
|
|
|
|
281
|
return $param; |
495
|
|
|
|
|
|
|
} |
496
|
|
|
|
|
|
|
|
497
|
|
|
|
|
|
|
sub _param_typed { |
498
|
232
|
|
|
232
|
|
346
|
my ($self, $param) = @_; |
499
|
|
|
|
|
|
|
|
500
|
232
|
100
|
|
|
|
690
|
my $tc = $self->tc |
501
|
|
|
|
|
|
|
or return; |
502
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
|
504
|
29
|
100
|
|
|
|
969
|
$tc = $self->type_constraint_class->new( |
|
|
50
|
|
|
|
|
|
505
|
|
|
|
|
|
|
ppi => $tc, |
506
|
|
|
|
|
|
|
( $self->has_type_constraint_callback |
507
|
|
|
|
|
|
|
? (tc_callback => $self->type_constraint_callback) |
508
|
|
|
|
|
|
|
: () |
509
|
|
|
|
|
|
|
), |
510
|
|
|
|
|
|
|
( $self->has_from_namespace |
511
|
|
|
|
|
|
|
? ( from_namespace => $self->from_namespace ) |
512
|
|
|
|
|
|
|
: () |
513
|
|
|
|
|
|
|
), |
514
|
|
|
|
|
|
|
); |
515
|
29
|
|
|
|
|
72
|
$param->{type_constraints} = $tc; |
516
|
|
|
|
|
|
|
|
517
|
29
|
|
|
|
|
44
|
return $param; |
518
|
|
|
|
|
|
|
} |
519
|
|
|
|
|
|
|
|
520
|
|
|
|
|
|
|
sub _param_default { |
521
|
209
|
|
|
209
|
|
282
|
my ($self, $param) = @_; |
522
|
|
|
|
|
|
|
|
523
|
209
|
100
|
|
|
|
5198
|
return unless $self->ppi->content eq '='; |
524
|
|
|
|
|
|
|
|
525
|
25
|
|
|
|
|
123
|
$self->consume_token; |
526
|
|
|
|
|
|
|
|
527
|
|
|
|
|
|
|
$param->{default_value} = |
528
|
25
|
50
|
66
|
|
|
94
|
$self->_consume_if_isa(qw/ |
529
|
|
|
|
|
|
|
PPI::Token::QuoteLike |
530
|
|
|
|
|
|
|
PPI::Token::Number |
531
|
|
|
|
|
|
|
PPI::Token::Quote |
532
|
|
|
|
|
|
|
PPI::Token::Symbol |
533
|
|
|
|
|
|
|
PPI::Token::Magic |
534
|
|
|
|
|
|
|
PPI::Token::ArrayIndex |
535
|
|
|
|
|
|
|
/) || |
536
|
|
|
|
|
|
|
$self->bracketed('[') || |
537
|
|
|
|
|
|
|
$self->bracketed('{') |
538
|
|
|
|
|
|
|
or $self->error($self->ppi); |
539
|
|
|
|
|
|
|
|
540
|
25
|
|
|
|
|
88
|
$param->{default_value} = $param->{default_value}->content; |
541
|
|
|
|
|
|
|
} |
542
|
|
|
|
|
|
|
|
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
sub _param_variable { |
545
|
222
|
|
|
222
|
|
1658
|
my ($self, $param) = @_; |
546
|
|
|
|
|
|
|
|
547
|
222
|
|
|
|
|
5490
|
my $ppi = $self->ppi; |
548
|
222
|
|
|
|
|
689
|
my $class = $ppi->class; |
549
|
222
|
100
|
100
|
|
|
1260
|
return unless $class eq 'PPI::Token::Symbol' |
550
|
|
|
|
|
|
|
|| $class eq 'PPI::Token::Cast'; |
551
|
|
|
|
|
|
|
|
552
|
197
|
100
|
|
|
|
512
|
if ($class eq 'PPI::Token::Symbol') { |
553
|
187
|
100
|
|
|
|
755
|
$ppi->symbol_type eq $ppi->raw_type or $self->error($ppi); |
554
|
|
|
|
|
|
|
|
555
|
186
|
|
|
|
|
10049
|
$param->{sigil} = $ppi->raw_type; |
556
|
186
|
|
|
|
|
1088
|
$param->{variable_name} = $self->consume_token->content; |
557
|
|
|
|
|
|
|
} else { |
558
|
10
|
|
|
|
|
22
|
$param->{sigil} = $self->consume_token->content; |
559
|
|
|
|
|
|
|
} |
560
|
|
|
|
|
|
|
|
561
|
196
|
|
|
|
|
1394
|
return $param; |
562
|
|
|
|
|
|
|
} |
563
|
|
|
|
|
|
|
|
564
|
|
|
|
|
|
|
sub unpacked_hash { |
565
|
9
|
|
|
9
|
0
|
22
|
my ($self, $list, $param) = @_; |
566
|
|
|
|
|
|
|
|
567
|
9
|
|
|
|
|
22
|
my $params = []; |
568
|
9
|
|
|
|
|
232
|
while ($self->ppi->content ne '}') { |
569
|
20
|
|
|
|
|
524
|
my $errctx = $self->ppi; |
570
|
20
|
50
|
|
|
|
69
|
my $p = $self->param |
571
|
|
|
|
|
|
|
or $self->error($self->ppi); |
572
|
|
|
|
|
|
|
|
573
|
20
|
100
|
100
|
|
|
640
|
$self->error($errctx, "Cannot have positional parameters in an unpacked-array") |
574
|
|
|
|
|
|
|
if $p->sigil eq '$' && PositionalParam->check($p); |
575
|
19
|
|
|
|
|
12637
|
push @$params, $p; |
576
|
|
|
|
|
|
|
|
577
|
19
|
100
|
|
|
|
523
|
last if $self->ppi->content eq '}'; |
578
|
11
|
|
|
|
|
100
|
$self->assert_token(','); |
579
|
|
|
|
|
|
|
} |
580
|
8
|
|
|
|
|
56
|
$param->{params} = $params; |
581
|
8
|
|
|
|
|
20
|
$param->{sigil} = '$'; |
582
|
8
|
|
|
|
|
16
|
$param->{unpacking} = 'Hash'; |
583
|
8
|
|
|
|
|
19
|
return $param; |
584
|
|
|
|
|
|
|
} |
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
sub unpacked_array { |
587
|
12
|
|
|
12
|
0
|
23
|
my ($self, $list, $param) = @_; |
588
|
|
|
|
|
|
|
|
589
|
12
|
|
|
|
|
15
|
my $params = []; |
590
|
12
|
|
|
|
|
310
|
while ($self->ppi->content ne ']') { |
591
|
27
|
|
|
|
|
704
|
my $watermark = $self->ppi; |
592
|
27
|
50
|
|
|
|
82
|
my $param = $self->param |
593
|
|
|
|
|
|
|
or $self->error($self->ppi); |
594
|
|
|
|
|
|
|
|
595
|
26
|
100
|
|
|
|
124
|
$self->error($watermark, "Cannot have named parameters in an unpacked-array") |
596
|
|
|
|
|
|
|
if NamedParam->check($param); |
597
|
|
|
|
|
|
|
|
598
|
24
|
100
|
|
|
|
23322
|
$self->error($watermark, "Cannot have optional parameters in an unpacked-array") |
599
|
|
|
|
|
|
|
unless $param->required; |
600
|
|
|
|
|
|
|
|
601
|
23
|
|
|
|
|
55
|
push @$params, $param; |
602
|
|
|
|
|
|
|
|
603
|
23
|
100
|
|
|
|
589
|
last if $self->ppi->content eq ']'; |
604
|
15
|
|
|
|
|
99
|
$self->assert_token(','); |
605
|
|
|
|
|
|
|
} |
606
|
8
|
|
|
|
|
60
|
$param->{params} = $params; |
607
|
8
|
|
|
|
|
18
|
$param->{sigil} = '$'; |
608
|
8
|
|
|
|
|
17
|
$param->{unpacking} = 'Array'; |
609
|
8
|
|
|
|
|
24
|
return $param; |
610
|
|
|
|
|
|
|
} |
611
|
|
|
|
|
|
|
|
612
|
|
|
|
|
|
|
sub tc { |
613
|
267
|
|
|
267
|
0
|
357
|
my ($self, $required) = @_; |
614
|
|
|
|
|
|
|
|
615
|
267
|
|
|
|
|
609
|
my $ident = $self->_ident; |
616
|
|
|
|
|
|
|
|
617
|
267
|
50
|
66
|
|
|
1525
|
$ident or ($required and $self->error($self->ppi)) or return; |
|
|
|
66
|
|
|
|
|
618
|
|
|
|
|
|
|
|
619
|
64
|
|
66
|
|
|
222
|
return $self->_tc_union( |
620
|
|
|
|
|
|
|
$self->bracketed('[', \&_tc_params, $ident) |
621
|
|
|
|
|
|
|
|| $ident->clone |
622
|
|
|
|
|
|
|
); |
623
|
|
|
|
|
|
|
} |
624
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
# Handle parameterized TCs. e.g.: |
626
|
|
|
|
|
|
|
# ArrayRef[Str] |
627
|
|
|
|
|
|
|
# Dict[Str => Str] |
628
|
|
|
|
|
|
|
# Dict["foo bar", Baz] |
629
|
|
|
|
|
|
|
sub _tc_params { |
630
|
15
|
|
|
15
|
|
22
|
my ($self, $list, $tc) = @_; |
631
|
|
|
|
|
|
|
|
632
|
15
|
|
|
|
|
36
|
my $new = PPI::Statement::Expression::TCParams->new($tc->clone); |
633
|
|
|
|
|
|
|
|
634
|
15
|
100
|
|
|
|
4031
|
return $new if $self->ppi->content eq ']'; |
635
|
|
|
|
|
|
|
|
636
|
14
|
|
|
|
|
83
|
$new->add_element($self->_tc_param); |
637
|
|
|
|
|
|
|
|
638
|
13
|
|
|
|
|
318
|
while ($self->ppi->content =~ /^,|=>$/ ) { |
639
|
|
|
|
|
|
|
|
640
|
6
|
|
|
|
|
39
|
my $op = $self->consume_token; |
641
|
6
|
100
|
|
|
|
19
|
$self->_stringify_last($new) if $op->content eq '=>'; |
642
|
|
|
|
|
|
|
|
643
|
6
|
|
|
|
|
18
|
$new->add_element($self->tc(1)); |
644
|
|
|
|
|
|
|
} |
645
|
|
|
|
|
|
|
|
646
|
13
|
|
|
|
|
65
|
return $new; |
647
|
|
|
|
|
|
|
} |
648
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
# Valid token for individual component of parameterized TC |
650
|
|
|
|
|
|
|
sub _tc_param { |
651
|
14
|
|
|
14
|
|
20
|
my ($self) = @_; |
652
|
|
|
|
|
|
|
|
653
|
14
|
|
|
|
|
330
|
(my $class = $self->ppi->class) =~ s/^PPI:://; |
654
|
14
|
100
|
100
|
|
|
151
|
return $self->consume_token->clone |
655
|
|
|
|
|
|
|
if $class eq 'Token::Number' || |
656
|
|
|
|
|
|
|
$class =~ /^Token::Quote::(?:Single|Double|Literal|Interpolate)/; |
657
|
|
|
|
|
|
|
|
658
|
12
|
|
|
|
|
39
|
return $self->tc(1); |
659
|
|
|
|
|
|
|
} |
660
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
sub _tc_union { |
662
|
61
|
|
|
61
|
|
949
|
my ($self, $tc) = @_; |
663
|
|
|
|
|
|
|
|
664
|
61
|
100
|
|
|
|
1547
|
return $tc unless $self->ppi->content eq '|'; |
665
|
|
|
|
|
|
|
|
666
|
9
|
|
|
|
|
90
|
my $union = PPI::Statement::Expression::TCUnion->new; |
667
|
9
|
|
|
|
|
97
|
$union->add_element($tc); |
668
|
9
|
|
|
|
|
590
|
while ( $self->ppi->content eq '|' ) { |
669
|
|
|
|
|
|
|
|
670
|
9
|
|
|
|
|
51
|
$self->consume_token; |
671
|
9
|
|
|
|
|
27
|
$union->add_element($self->tc(1)); |
672
|
|
|
|
|
|
|
} |
673
|
|
|
|
|
|
|
|
674
|
8
|
|
|
|
|
50
|
return $union; |
675
|
|
|
|
|
|
|
} |
676
|
|
|
|
|
|
|
|
677
|
|
|
|
|
|
|
# Stringify LHS of fat comma |
678
|
|
|
|
|
|
|
sub _stringify_last { |
679
|
4
|
|
|
4
|
|
26
|
my ($self, $list) = @_; |
680
|
4
|
|
|
|
|
31
|
my $last = $list->last_token; |
681
|
4
|
100
|
|
|
|
65
|
return unless $last->isa('PPI::Token::Word'); |
682
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
# Is this conditional on the content of the word? |
684
|
3
|
|
|
|
|
14
|
bless $last, "PPI::Token::StringifiedWord"; |
685
|
3
|
|
|
|
|
5
|
return $list; |
686
|
|
|
|
|
|
|
} |
687
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
# Handle the boring bits of bracketed product, then call $code->($self, ...) |
689
|
|
|
|
|
|
|
sub bracketed { |
690
|
131
|
|
|
131
|
0
|
414
|
my ($self, $type, $code, @args) = @_; |
691
|
|
|
|
|
|
|
|
692
|
131
|
|
|
|
|
195
|
local $ERROR_LEVEL = $ERROR_LEVEL + 1; |
693
|
131
|
|
|
|
|
3176
|
my $ppi = $self->ppi; |
694
|
131
|
100
|
|
|
|
321
|
return unless $ppi->content eq $type; |
695
|
|
|
|
|
|
|
|
696
|
40
|
|
|
|
|
188
|
$self->consume_token; # consume '['; |
697
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
# Get from the '[' token the to Strucure::Constructor |
699
|
40
|
|
|
|
|
93
|
$ppi = $ppi->parent; |
700
|
|
|
|
|
|
|
|
701
|
40
|
100
|
|
|
|
184
|
$ppi->finish or $self->error($ppi, |
702
|
|
|
|
|
|
|
"Runaway '" . $ppi->braces . "' in " . $self->_parsing_area(1), 1); |
703
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
|
705
|
38
|
|
|
|
|
162
|
my $ret; |
706
|
38
|
100
|
|
|
|
89
|
if ($code) { |
707
|
36
|
|
|
|
|
83
|
my $list = PPI::Structure::Constructor->new($ppi->start->clone); |
708
|
36
|
|
|
|
|
971
|
$ret = $code->($self, $list, @args); |
709
|
|
|
|
|
|
|
|
710
|
30
|
100
|
|
|
|
755
|
$self->error($self->ppi) |
711
|
|
|
|
|
|
|
if $self->ppi != $ppi->finish; |
712
|
|
|
|
|
|
|
|
713
|
|
|
|
|
|
|
# There is no public way to do this as of PPI 1.204_06. I'll add one to the |
714
|
|
|
|
|
|
|
# next release, 1.205 (or so) |
715
|
29
|
|
|
|
|
420
|
$list->{finish} = $self->consume_token->clone; |
716
|
|
|
|
|
|
|
} else { |
717
|
|
|
|
|
|
|
# Just clone the entire [] or {} |
718
|
2
|
|
|
|
|
14
|
$ret = $ppi->clone; |
719
|
2
|
|
|
|
|
177
|
$self->_set_ppi($ppi->finish); |
720
|
2
|
|
|
|
|
44
|
$self->consume_token; |
721
|
|
|
|
|
|
|
} |
722
|
|
|
|
|
|
|
|
723
|
31
|
|
|
|
|
988
|
return $ret; |
724
|
|
|
|
|
|
|
} |
725
|
|
|
|
|
|
|
|
726
|
|
|
|
|
|
|
# Work out what sort of production we are in for sane default error messages |
727
|
|
|
|
|
|
|
sub _parsing_area { |
728
|
19
|
|
|
19
|
|
90
|
shift; |
729
|
19
|
|
50
|
|
|
45
|
my $height = shift || 0; |
730
|
19
|
|
|
|
|
80
|
my (undef, undef, undef, $sub) = caller($height+$ERROR_LEVEL); |
731
|
|
|
|
|
|
|
|
732
|
19
|
100
|
|
|
|
693
|
return "type constraint" if $sub =~ /(?:\b|_)tc(?:\b|_)/; |
733
|
15
|
100
|
|
|
|
59
|
return "unpacked parameter" |
734
|
|
|
|
|
|
|
if $sub =~ /(?:\b|_)unpacked(?:\b|_)/; |
735
|
14
|
100
|
|
|
|
68
|
return "parameter" if $sub =~ /(?:\b|_)param(?:\b|_)/; |
736
|
9
|
50
|
|
|
|
72
|
return "signature" if $sub =~ /(?:\b|_)signature(?:\b|_)/; |
737
|
|
|
|
|
|
|
|
738
|
0
|
|
|
|
|
0
|
" unknown production ($sub)"; |
739
|
|
|
|
|
|
|
} |
740
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
# error(PPI::Token $token, Str $msg?, Bool $no_in = 0) |
742
|
|
|
|
|
|
|
sub error { |
743
|
30
|
|
|
30
|
0
|
2812
|
my ($self, $token, $msg, $no_in) = @_; |
744
|
|
|
|
|
|
|
|
745
|
30
|
100
|
|
|
|
84
|
$msg = "Error parsing " . $self->_parsing_area(2) |
746
|
|
|
|
|
|
|
unless ($msg); |
747
|
|
|
|
|
|
|
|
748
|
|
|
|
|
|
|
|
749
|
30
|
100
|
|
|
|
105
|
$msg = $msg . " near '$token'" . |
750
|
|
|
|
|
|
|
($no_in ? "" |
751
|
|
|
|
|
|
|
: " in '" . $token->statement . "'" |
752
|
|
|
|
|
|
|
); |
753
|
|
|
|
|
|
|
|
754
|
30
|
50
|
|
|
|
1368
|
if ($DEBUG) { |
755
|
0
|
|
|
|
|
0
|
Carp::confess($msg); |
756
|
|
|
|
|
|
|
} else { |
757
|
30
|
|
|
|
|
532
|
Carp::croak($msg); |
758
|
|
|
|
|
|
|
} |
759
|
|
|
|
|
|
|
} |
760
|
|
|
|
|
|
|
|
761
|
|
|
|
|
|
|
sub assert_token { |
762
|
265
|
|
|
265
|
0
|
493
|
my ($self, $need, $msg) = @_; |
763
|
|
|
|
|
|
|
|
764
|
265
|
100
|
|
|
|
6723
|
if ($self->ppi->content ne $need) { |
765
|
9
|
|
|
|
|
235
|
$self->error($self->ppi, "'$need' expected whilst parsing " . $self->_parsing_area(2)); |
766
|
|
|
|
|
|
|
} |
767
|
256
|
|
|
|
|
1490
|
return $self->consume_token; |
768
|
|
|
|
|
|
|
} |
769
|
|
|
|
|
|
|
|
770
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
%LEXTABLE = ( |
772
|
|
|
|
|
|
|
where => 'WHERE', |
773
|
|
|
|
|
|
|
is => 'TRAIT', |
774
|
|
|
|
|
|
|
does => 'TRAIT', |
775
|
|
|
|
|
|
|
); |
776
|
|
|
|
|
|
|
|
777
|
|
|
|
|
|
|
sub _ident { |
778
|
270
|
|
|
270
|
|
290
|
my ($self) = @_; |
779
|
|
|
|
|
|
|
|
780
|
270
|
|
|
|
|
6385
|
my $ppi = $self->ppi; |
781
|
270
|
100
|
|
|
|
628
|
return $self->consume_token |
782
|
|
|
|
|
|
|
if $ppi->class eq 'PPI::Token::Word'; |
783
|
204
|
|
|
|
|
926
|
return undef; |
784
|
|
|
|
|
|
|
} |
785
|
|
|
|
|
|
|
|
786
|
|
|
|
|
|
|
sub _consume_if_isa { |
787
|
25
|
|
|
25
|
|
72
|
my ($self, @classes) = @_; |
788
|
|
|
|
|
|
|
|
789
|
25
|
|
|
|
|
56
|
for (@classes) { |
790
|
74
|
100
|
|
|
|
1764
|
return $self->consume_token |
791
|
|
|
|
|
|
|
if $self->ppi->isa($_); |
792
|
|
|
|
|
|
|
} |
793
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
} |
795
|
|
|
|
|
|
|
|
796
|
|
|
|
|
|
|
sub consume_token { |
797
|
833
|
|
|
833
|
0
|
1285
|
my ($self) = @_; |
798
|
|
|
|
|
|
|
|
799
|
833
|
|
|
|
|
20189
|
my $ppi = $self->ppi; |
800
|
833
|
|
|
|
|
888
|
my $ret = $ppi; |
801
|
|
|
|
|
|
|
|
802
|
833
|
|
|
|
|
3390
|
while (!$ppi->isa('PPI::Token::EOF') ) { |
803
|
1052
|
|
|
|
|
2787
|
$ppi = $ppi->next_token; |
804
|
1052
|
100
|
|
|
|
32544
|
last if $ppi->significant; |
805
|
|
|
|
|
|
|
} |
806
|
|
|
|
|
|
|
|
807
|
833
|
100
|
100
|
|
|
1930
|
if ($ppi->class eq 'PPI::Token::Word' && exists $LEXTABLE{"$ppi"}) { |
808
|
22
|
|
|
|
|
230
|
bless $ppi, "PPI::Token::LexSymbol"; |
809
|
22
|
|
|
|
|
219
|
$ppi->{lex} = $LEXTABLE{"$ppi"}; |
810
|
|
|
|
|
|
|
} |
811
|
833
|
|
|
|
|
27699
|
$self->_set_ppi( $ppi ); |
812
|
833
|
|
|
|
|
2084
|
return $ret; |
813
|
|
|
|
|
|
|
} |
814
|
|
|
|
|
|
|
|
815
|
|
|
|
|
|
|
sub remaining_input { |
816
|
0
|
|
|
0
|
0
|
0
|
my $tok = $_[0]->ppi; |
817
|
0
|
|
|
|
|
0
|
my $buff; |
818
|
|
|
|
|
|
|
|
819
|
0
|
|
|
|
|
0
|
while ( !$tok->isa('PPI::Token::EOF') ) { |
820
|
0
|
|
|
|
|
0
|
$buff .= $tok->content; |
821
|
0
|
|
|
|
|
0
|
$tok = $tok->next_token; |
822
|
|
|
|
|
|
|
} |
823
|
0
|
|
|
|
|
0
|
return $buff; |
824
|
|
|
|
|
|
|
} |
825
|
|
|
|
|
|
|
|
826
|
|
|
|
|
|
|
__PACKAGE__->meta->make_immutable; |
827
|
|
|
|
|
|
|
|
828
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
# Extra PPI classes to represent what we want. |
830
|
|
|
|
|
|
|
{ package |
831
|
|
|
|
|
|
|
PPI::Statement::Expression::TCUnion; |
832
|
3
|
|
|
3
|
|
11660
|
use base 'PPI::Statement::Expression'; |
|
3
|
|
|
|
|
3
|
|
|
3
|
|
|
|
|
375
|
|
833
|
|
|
|
|
|
|
|
834
|
|
|
|
|
|
|
sub content { |
835
|
6
|
|
|
6
|
|
236
|
join('|', $_[0]->children ); |
836
|
|
|
|
|
|
|
} |
837
|
|
|
|
|
|
|
} |
838
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
{ package |
840
|
|
|
|
|
|
|
PPI::Statement::Expression::TCParams; |
841
|
|
|
|
|
|
|
|
842
|
3
|
|
|
3
|
|
13
|
use base 'PPI::Statement::Expression'; |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
174
|
|
843
|
3
|
|
|
3
|
|
13
|
use Moose; |
|
3
|
|
|
|
|
3
|
|
|
3
|
|
|
|
|
23
|
|
844
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
# $self->children stores everything so PPI can track parents |
846
|
|
|
|
|
|
|
# params just contains the keywords (not commas) inside the [] |
847
|
|
|
|
|
|
|
has type => ( is => 'ro'); |
848
|
|
|
|
|
|
|
has params => ( |
849
|
|
|
|
|
|
|
is => 'ro', |
850
|
|
|
|
|
|
|
default => sub { [] }, |
851
|
|
|
|
|
|
|
); |
852
|
|
|
|
|
|
|
|
853
|
|
|
|
|
|
|
sub new { |
854
|
15
|
|
|
15
|
0
|
206
|
my ($class, $type) = @_; |
855
|
|
|
|
|
|
|
|
856
|
15
|
|
|
|
|
65
|
return $class->meta->new_object( |
857
|
|
|
|
|
|
|
__INSTANCE__ => $class->SUPER::new($type), |
858
|
|
|
|
|
|
|
type => $type |
859
|
|
|
|
|
|
|
); |
860
|
|
|
|
|
|
|
}; |
861
|
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
override add_element => sub { |
863
|
|
|
|
|
|
|
my ($self, $ele) = @_; |
864
|
|
|
|
|
|
|
super(); |
865
|
|
|
|
|
|
|
push @{$self->params}, $ele; |
866
|
|
|
|
|
|
|
}; |
867
|
|
|
|
|
|
|
|
868
|
|
|
|
|
|
|
sub content { |
869
|
10
|
|
|
10
|
1
|
1037
|
$_[0]->type->content . '[' . join(',', @{$_[0]->params}) . ']' |
|
10
|
|
|
|
|
294
|
|
870
|
|
|
|
|
|
|
} |
871
|
|
|
|
|
|
|
|
872
|
3
|
|
|
3
|
|
15998
|
no Moose; |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
12
|
|
873
|
|
|
|
|
|
|
} |
874
|
|
|
|
|
|
|
|
875
|
|
|
|
|
|
|
{ package |
876
|
|
|
|
|
|
|
PPI::Token::LexSymbol; |
877
|
3
|
|
|
3
|
|
480
|
use base 'PPI::Token::Word'; |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
331
|
|
878
|
|
|
|
|
|
|
|
879
|
|
|
|
|
|
|
sub lex { |
880
|
31
|
|
|
31
|
|
42
|
my ($self) = @_; |
881
|
|
|
|
|
|
|
return $self->{lex} |
882
|
31
|
|
|
|
|
138
|
} |
883
|
|
|
|
|
|
|
} |
884
|
|
|
|
|
|
|
|
885
|
|
|
|
|
|
|
# Used for LHS of fat comma |
886
|
|
|
|
|
|
|
{ package |
887
|
|
|
|
|
|
|
PPI::Token::StringifiedWord; |
888
|
3
|
|
|
3
|
|
12
|
use base 'PPI::Token::Word'; |
|
3
|
|
|
|
|
3
|
|
|
3
|
|
|
|
|
145
|
|
889
|
|
|
|
|
|
|
|
890
|
3
|
|
|
3
|
|
12
|
use Moose; |
|
3
|
|
|
|
|
4
|
|
|
3
|
|
|
|
|
11
|
|
891
|
|
|
|
|
|
|
override content => sub { |
892
|
|
|
|
|
|
|
return '"' . super() . '"'; |
893
|
|
|
|
|
|
|
}; |
894
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
sub string { |
896
|
1
|
|
|
1
|
0
|
5
|
return $_[0]->PPI::Token::Word::content(); |
897
|
|
|
|
|
|
|
} |
898
|
3
|
|
|
3
|
|
13009
|
no Moose; |
|
3
|
|
|
|
|
4
|
|
|
3
|
|
|
|
|
11
|
|
899
|
|
|
|
|
|
|
} |
900
|
|
|
|
|
|
|
|
901
|
|
|
|
|
|
|
1; |
902
|
|
|
|
|
|
|
|
903
|
|
|
|
|
|
|
__END__ |
904
|
|
|
|
|
|
|
|
905
|
|
|
|
|
|
|
=head1 NAME |
906
|
|
|
|
|
|
|
|
907
|
|
|
|
|
|
|
Parse::Method::Signatures - Perl6 like method signature parser |
908
|
|
|
|
|
|
|
|
909
|
|
|
|
|
|
|
=head1 DESCRIPTION |
910
|
|
|
|
|
|
|
|
911
|
|
|
|
|
|
|
Inspired by L<Perl6::Signature> but streamlined to just support the subset |
912
|
|
|
|
|
|
|
deemed useful for L<TryCatch> and L<MooseX::Method::Signatures>. |
913
|
|
|
|
|
|
|
|
914
|
|
|
|
|
|
|
=head1 TODO |
915
|
|
|
|
|
|
|
|
916
|
|
|
|
|
|
|
=over |
917
|
|
|
|
|
|
|
|
918
|
|
|
|
|
|
|
=item * Document the parameter return types. |
919
|
|
|
|
|
|
|
|
920
|
|
|
|
|
|
|
=item * Probably lots of other things |
921
|
|
|
|
|
|
|
|
922
|
|
|
|
|
|
|
=back |
923
|
|
|
|
|
|
|
|
924
|
|
|
|
|
|
|
=head1 METHODS |
925
|
|
|
|
|
|
|
|
926
|
|
|
|
|
|
|
There are only two public methods to this module, both of which should be |
927
|
|
|
|
|
|
|
called as class methods. Both methods accept either a single (non-ref) scalar |
928
|
|
|
|
|
|
|
as the value for the L</input> attribute, or normal new style arguments (hash |
929
|
|
|
|
|
|
|
or hash-ref). |
930
|
|
|
|
|
|
|
|
931
|
|
|
|
|
|
|
=head2 signature |
932
|
|
|
|
|
|
|
|
933
|
|
|
|
|
|
|
my $sig = Parse::Method::Signatures->signature( '(Str $foo)' ) |
934
|
|
|
|
|
|
|
|
935
|
|
|
|
|
|
|
Attempts to parse the (bracketed) method signature. Returns a value or croaks |
936
|
|
|
|
|
|
|
on error. |
937
|
|
|
|
|
|
|
|
938
|
|
|
|
|
|
|
=head2 param |
939
|
|
|
|
|
|
|
|
940
|
|
|
|
|
|
|
my $param = Parse::Method::Signatures->param( 'Str $foo where { length($_) < 10 }') |
941
|
|
|
|
|
|
|
|
942
|
|
|
|
|
|
|
Attempts to parse the specification for a single parameter. Returns value or |
943
|
|
|
|
|
|
|
croaks on error. |
944
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
=head1 ATTRIBUTES |
946
|
|
|
|
|
|
|
|
947
|
|
|
|
|
|
|
All the attributes on this class are read-only. |
948
|
|
|
|
|
|
|
|
949
|
|
|
|
|
|
|
=head2 input |
950
|
|
|
|
|
|
|
|
951
|
|
|
|
|
|
|
B<Type:> Str |
952
|
|
|
|
|
|
|
|
953
|
|
|
|
|
|
|
The string to parse. |
954
|
|
|
|
|
|
|
|
955
|
|
|
|
|
|
|
=head2 offset |
956
|
|
|
|
|
|
|
|
957
|
|
|
|
|
|
|
B<Type:> Int |
958
|
|
|
|
|
|
|
|
959
|
|
|
|
|
|
|
Offset into L</input> at which to start parsing. Useful for using with |
960
|
|
|
|
|
|
|
Devel::Declare linestring |
961
|
|
|
|
|
|
|
|
962
|
|
|
|
|
|
|
=head2 signature_class |
963
|
|
|
|
|
|
|
|
964
|
|
|
|
|
|
|
B<Default:> Parse::Method::Signatures::Sig |
965
|
|
|
|
|
|
|
|
966
|
|
|
|
|
|
|
B<Type:> Str (loaded on demand class name) |
967
|
|
|
|
|
|
|
|
968
|
|
|
|
|
|
|
=head2 param_class |
969
|
|
|
|
|
|
|
|
970
|
|
|
|
|
|
|
B<Default:> Parse::Method::Signatures::Param |
971
|
|
|
|
|
|
|
|
972
|
|
|
|
|
|
|
B<Type:> Str (loaded on demand class name) |
973
|
|
|
|
|
|
|
|
974
|
|
|
|
|
|
|
=head2 type_constraint_class |
975
|
|
|
|
|
|
|
|
976
|
|
|
|
|
|
|
B<Default:> L<Parse::Method::Signatures::TypeConstraint> |
977
|
|
|
|
|
|
|
|
978
|
|
|
|
|
|
|
B<Type:> Str (loaded on demand class name) |
979
|
|
|
|
|
|
|
|
980
|
|
|
|
|
|
|
Class that is used to turn the parsed type constraint into an actual |
981
|
|
|
|
|
|
|
L<Moose::Meta::TypeConstraint> object. |
982
|
|
|
|
|
|
|
|
983
|
|
|
|
|
|
|
=head2 from_namespace |
984
|
|
|
|
|
|
|
|
985
|
|
|
|
|
|
|
B<Type:> ClassName |
986
|
|
|
|
|
|
|
|
987
|
|
|
|
|
|
|
Let this module know which package it is parsing signatures form. This is |
988
|
|
|
|
|
|
|
entirely optional, and the only effect is has is on parsing type constraints. |
989
|
|
|
|
|
|
|
|
990
|
|
|
|
|
|
|
If this attribute is set it is passed to L</type_constraint_class> which can |
991
|
|
|
|
|
|
|
use it to introspect the package (commonly for L<MooseX::Types> exported |
992
|
|
|
|
|
|
|
types). See |
993
|
|
|
|
|
|
|
L<Parse::Method::Signature::TypeConstraints/find_registered_constraint> for |
994
|
|
|
|
|
|
|
more details. |
995
|
|
|
|
|
|
|
|
996
|
|
|
|
|
|
|
=head2 type_constraint_callback |
997
|
|
|
|
|
|
|
|
998
|
|
|
|
|
|
|
B<Type:> CodeRef |
999
|
|
|
|
|
|
|
|
1000
|
|
|
|
|
|
|
Passed to the constructor of L</type_constraint_class>. Default implementation |
1001
|
|
|
|
|
|
|
of this callback asks Moose for a type constrain matching the name passed in. |
1002
|
|
|
|
|
|
|
If you have more complex requirements, such as parsing types created by |
1003
|
|
|
|
|
|
|
L<MooseX::Types> then you will want a callback similar to this: |
1004
|
|
|
|
|
|
|
|
1005
|
|
|
|
|
|
|
# my $target_package defined elsewhere. |
1006
|
|
|
|
|
|
|
my $tc_cb = sub { |
1007
|
|
|
|
|
|
|
my ($pms_tc, $name) = @_; |
1008
|
|
|
|
|
|
|
my $code = $target_package->can($name); |
1009
|
|
|
|
|
|
|
$code ? eval { $code->() } |
1010
|
|
|
|
|
|
|
: $pms_tc->find_registered_constraint($name); |
1011
|
|
|
|
|
|
|
} |
1012
|
|
|
|
|
|
|
|
1013
|
|
|
|
|
|
|
Note that the above example is better provided by providing the |
1014
|
|
|
|
|
|
|
L</from_namespace> attribute. |
1015
|
|
|
|
|
|
|
|
1016
|
|
|
|
|
|
|
=head1 CAVEATS |
1017
|
|
|
|
|
|
|
|
1018
|
|
|
|
|
|
|
Like Perl6::Signature, the parsing of certain constructs is currently only a |
1019
|
|
|
|
|
|
|
'best effort' - specifically default values and where code blocks might not |
1020
|
|
|
|
|
|
|
successfully for certain complex cases. Patches/Failing tests welcome. |
1021
|
|
|
|
|
|
|
|
1022
|
|
|
|
|
|
|
Additionally, default value specifications are not evaluated which means that |
1023
|
|
|
|
|
|
|
no such lexical or similar errors will not be produced by this module. |
1024
|
|
|
|
|
|
|
Constant folding will also not be performed. |
1025
|
|
|
|
|
|
|
|
1026
|
|
|
|
|
|
|
There are certain constructs that are simply too much hassle to avoid when the |
1027
|
|
|
|
|
|
|
work around is simple. Currently the only cases that are known to parse wrong |
1028
|
|
|
|
|
|
|
are when using anonymous variables (i.e. just sigils) in unpacked arrays. Take |
1029
|
|
|
|
|
|
|
the following example: |
1030
|
|
|
|
|
|
|
|
1031
|
|
|
|
|
|
|
method foo (ArrayRef [$, $], $some_value_we_care_about) { |
1032
|
|
|
|
|
|
|
|
1033
|
|
|
|
|
|
|
In this case the C<$]> is treated as one of perl's magic variables |
1034
|
|
|
|
|
|
|
(specifically, the patch level of the Perl interpreter) rather than a C<$> |
1035
|
|
|
|
|
|
|
followed by a C<]> as was almost certainly intended. The work around for this |
1036
|
|
|
|
|
|
|
is simple: introduce a space between the characters: |
1037
|
|
|
|
|
|
|
|
1038
|
|
|
|
|
|
|
method foo (ArrayRef [ $, $ ], $some_value_we_care_about) { |
1039
|
|
|
|
|
|
|
|
1040
|
|
|
|
|
|
|
The same applies |
1041
|
|
|
|
|
|
|
|
1042
|
|
|
|
|
|
|
=head1 AUTHOR |
1043
|
|
|
|
|
|
|
|
1044
|
|
|
|
|
|
|
Ash Berlin <ash@cpan.org>. |
1045
|
|
|
|
|
|
|
|
1046
|
|
|
|
|
|
|
Thanks to Florian Ragwitz <rafl@debian.org>. |
1047
|
|
|
|
|
|
|
|
1048
|
|
|
|
|
|
|
Many thanks to Piers Cawley to showing me the way to refactor my spaghetti |
1049
|
|
|
|
|
|
|
code into something more manageable. |
1050
|
|
|
|
|
|
|
|
1051
|
|
|
|
|
|
|
=head1 SEE ALSO |
1052
|
|
|
|
|
|
|
|
1053
|
|
|
|
|
|
|
L<Devel::Declare> which is used by most modules that use this (currently by |
1054
|
|
|
|
|
|
|
all modules known to the author.) |
1055
|
|
|
|
|
|
|
|
1056
|
|
|
|
|
|
|
L<http://github.com/ashb/trycatch/tree>. |
1057
|
|
|
|
|
|
|
|
1058
|
|
|
|
|
|
|
=head1 LICENSE |
1059
|
|
|
|
|
|
|
|
1060
|
|
|
|
|
|
|
Licensed under the same terms as Perl itself. |
1061
|
|
|
|
|
|
|
|
1062
|
|
|
|
|
|
|
This distribution copyright 2008-2009, Ash Berlin <ash@cpan.org> |
1063
|
|
|
|
|
|
|
|