line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Sub::Meta; |
2
|
20
|
|
|
20
|
|
4429805
|
use 5.010; |
|
20
|
|
|
|
|
264
|
|
3
|
20
|
|
|
20
|
|
113
|
use strict; |
|
20
|
|
|
|
|
36
|
|
|
20
|
|
|
|
|
422
|
|
4
|
20
|
|
|
20
|
|
119
|
use warnings; |
|
20
|
|
|
|
|
44
|
|
|
20
|
|
|
|
|
1025
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
our $VERSION = "0.13"; |
7
|
|
|
|
|
|
|
|
8
|
20
|
|
|
20
|
|
133
|
use Carp (); |
|
20
|
|
|
|
|
34
|
|
|
20
|
|
|
|
|
400
|
|
9
|
20
|
|
|
20
|
|
113
|
use Scalar::Util (); |
|
20
|
|
|
|
|
50
|
|
|
20
|
|
|
|
|
361
|
|
10
|
20
|
|
|
20
|
|
9633
|
use Sub::Identify (); |
|
20
|
|
|
|
|
22822
|
|
|
20
|
|
|
|
|
419
|
|
11
|
20
|
|
|
20
|
|
9510
|
use Sub::Util (); |
|
20
|
|
|
|
|
5290
|
|
|
20
|
|
|
|
|
436
|
|
12
|
20
|
|
|
20
|
|
11391
|
use attributes (); |
|
20
|
|
|
|
|
24649
|
|
|
20
|
|
|
|
|
583
|
|
13
|
|
|
|
|
|
|
|
14
|
20
|
|
|
20
|
|
9819
|
use Sub::Meta::Parameters; |
|
20
|
|
|
|
|
65
|
|
|
20
|
|
|
|
|
684
|
|
15
|
20
|
|
|
20
|
|
10655
|
use Sub::Meta::Returns; |
|
20
|
|
|
|
|
59
|
|
|
20
|
|
|
|
|
883
|
|
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
BEGIN { |
18
|
|
|
|
|
|
|
# for Pure Perl |
19
|
20
|
|
|
20
|
|
897
|
$ENV{PERL_SUB_IDENTIFY_PP} = $ENV{PERL_SUB_META_PP}; ## no critic (RequireLocalizedPunctuationVars) |
20
|
|
|
|
|
|
|
} |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
use overload |
23
|
20
|
|
|
|
|
192
|
fallback => 1, |
24
|
|
|
|
|
|
|
eq => \&is_same_interface |
25
|
20
|
|
|
20
|
|
164
|
; |
|
20
|
|
|
|
|
42
|
|
26
|
|
|
|
|
|
|
|
27
|
29
|
|
|
29
|
1
|
141
|
sub parameters_class { return 'Sub::Meta::Parameters' } |
28
|
4
|
|
|
4
|
1
|
26
|
sub returns_class { return 'Sub::Meta::Returns' } |
29
|
|
|
|
|
|
|
|
30
|
5
|
|
|
5
|
|
41
|
sub _croak { require Carp; goto &Carp::croak } |
|
5
|
|
|
|
|
501
|
|
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
sub new { |
33
|
161
|
|
|
161
|
1
|
281115
|
my ($class, @args) = @_; |
34
|
161
|
100
|
|
|
|
538
|
my %args = @args == 1 ? %{$args[0]} : @args; |
|
75
|
|
|
|
|
280
|
|
35
|
|
|
|
|
|
|
|
36
|
161
|
|
|
|
|
398
|
my $self = bless \%args => $class; |
37
|
|
|
|
|
|
|
|
38
|
161
|
100
|
|
|
|
506
|
$self->set_sub(delete $args{sub}) if exists $args{sub}; # build subinfo |
39
|
161
|
100
|
|
|
|
554
|
$self->set_subname(delete $args{subname}) if exists $args{subname}; |
40
|
161
|
100
|
|
|
|
363
|
$self->set_stashname(delete $args{stashname}) if exists $args{stashname}; |
41
|
161
|
100
|
|
|
|
376
|
$self->set_fullname(delete $args{fullname}) if exists $args{fullname}; |
42
|
|
|
|
|
|
|
|
43
|
161
|
100
|
|
|
|
434
|
if (my $is_method = $self->_normalize_args_is_method(\%args)) { |
44
|
11
|
|
|
|
|
44
|
$self->set_is_method($is_method); |
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
|
47
|
161
|
100
|
|
|
|
504
|
if (my $parameters = $self->_normalize_args_parameters(\%args)) { |
48
|
47
|
|
|
|
|
156
|
$self->set_parameters($parameters); |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
|
51
|
161
|
100
|
|
|
|
398
|
if (exists $args{returns}) { |
52
|
|
|
|
|
|
|
$self->set_returns($args{returns}) |
53
|
22
|
|
|
|
|
58
|
} |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
# cleaning |
56
|
161
|
|
|
|
|
330
|
delete $args{args}; |
57
|
161
|
|
|
|
|
224
|
delete $args{slurpy}; |
58
|
161
|
|
|
|
|
287
|
delete $args{invocant}; |
59
|
161
|
|
|
|
|
218
|
delete $args{nshift}; |
60
|
|
|
|
|
|
|
|
61
|
161
|
|
|
|
|
493
|
return $self; |
62
|
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
sub _normalize_args_is_method { |
65
|
161
|
|
|
161
|
|
330
|
my ($self, $args) = @_; |
66
|
|
|
|
|
|
|
|
67
|
161
|
100
|
|
|
|
898
|
if (exists $args->{parameters}) { |
|
|
100
|
|
|
|
|
|
68
|
|
|
|
|
|
|
my $is_method = $args->{is_method} |
69
|
|
|
|
|
|
|
|| $args->{parameters}{nshift} |
70
|
27
|
|
100
|
|
|
160
|
|| $args->{parameters}{invocant}; |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
my $exists_is_method = exists $args->{is_method} |
73
|
|
|
|
|
|
|
|| exists $args->{parameters}{nshift} |
74
|
27
|
|
100
|
|
|
132
|
|| exists $args->{parameters}{invocant}; |
75
|
|
|
|
|
|
|
|
76
|
27
|
100
|
|
|
|
89
|
return $is_method if $exists_is_method |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
elsif(exists $args->{args}) { |
79
|
|
|
|
|
|
|
my $is_method = $args->{is_method} |
80
|
|
|
|
|
|
|
|| $args->{nshift} |
81
|
20
|
|
100
|
|
|
119
|
|| $args->{invocant}; |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
my $exists_is_method = exists $args->{is_method} |
84
|
|
|
|
|
|
|
|| exists $args->{nshift} |
85
|
20
|
|
100
|
|
|
96
|
|| exists $args->{invocant}; |
86
|
|
|
|
|
|
|
|
87
|
20
|
100
|
|
|
|
59
|
return $is_method if $exists_is_method; |
88
|
|
|
|
|
|
|
} |
89
|
148
|
|
|
|
|
400
|
return; |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
sub _normalize_args_parameters { |
93
|
161
|
|
|
161
|
|
319
|
my ($self, $args) = @_; |
94
|
|
|
|
|
|
|
|
95
|
161
|
100
|
|
|
|
498
|
if (exists $args->{parameters}) { |
|
|
100
|
|
|
|
|
|
96
|
27
|
|
|
|
|
110
|
return $args->{parameters}; |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
elsif(exists $args->{args}) { |
99
|
|
|
|
|
|
|
my $nshift = exists $args->{nshift} ? $args->{nshift} |
100
|
|
|
|
|
|
|
: $self->is_method ? 1 |
101
|
20
|
100
|
|
|
|
65
|
: exists $self->{is_method} ? 0 |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
102
|
|
|
|
|
|
|
: undef; |
103
|
|
|
|
|
|
|
|
104
|
20
|
|
|
|
|
59
|
my $parameters = { args => $args->{args} }; |
105
|
20
|
100
|
|
|
|
51
|
$parameters->{slurpy} = $args->{slurpy} if exists $args->{slurpy}; |
106
|
20
|
100
|
|
|
|
45
|
$parameters->{invocant} = $args->{invocant} if exists $args->{invocant}; |
107
|
20
|
100
|
|
|
|
50
|
$parameters->{nshift} = $nshift if defined $nshift; |
108
|
20
|
|
|
|
|
59
|
return $parameters; |
109
|
|
|
|
|
|
|
} |
110
|
114
|
|
|
|
|
307
|
return; |
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
|
113
|
486
|
|
|
486
|
1
|
17993
|
sub sub() :method { my $self = shift; return $self->{sub} } ## no critic (ProhibitBuiltinHomonyms) |
|
486
|
|
|
|
|
1999
|
|
114
|
244
|
|
100
|
244
|
1
|
6187
|
sub subname() { my $self = shift; return $self->subinfo->[1] // '' } |
|
244
|
|
|
|
|
425
|
|
115
|
47
|
|
100
|
47
|
1
|
5621
|
sub stashname() { my $self = shift; return $self->subinfo->[0] // '' } |
|
47
|
|
|
|
|
103
|
|
116
|
|
|
|
|
|
|
sub fullname() { |
117
|
39
|
|
|
39
|
1
|
5131
|
my $self = shift; |
118
|
39
|
|
|
|
|
81
|
my $s = ''; |
119
|
39
|
100
|
|
|
|
116
|
$s .= $self->stashname . '::' if $self->has_stashname; |
120
|
39
|
100
|
|
|
|
122
|
$s .= $self->subname if $self->has_subname; |
121
|
39
|
|
|
|
|
119
|
return $s; |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
sub subinfo() { |
125
|
652
|
|
|
652
|
1
|
6613
|
my $self = shift; |
126
|
652
|
100
|
|
|
|
3687
|
return $self->{subinfo} if $self->{subinfo}; |
127
|
65
|
|
|
|
|
198
|
$self->{subinfo} = $self->_build_subinfo; |
128
|
65
|
|
|
|
|
288
|
return $self->{subinfo}; |
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
|
131
|
46
|
|
100
|
46
|
1
|
8651
|
sub file() { my $self = shift; return $self->{file} ||= $self->_build_file } |
|
46
|
|
|
|
|
232
|
|
132
|
46
|
|
100
|
46
|
1
|
4416
|
sub line() { my $self = shift; return $self->{line} ||= $self->_build_line } |
|
46
|
|
|
|
|
204
|
|
133
|
73
|
|
100
|
73
|
1
|
4489
|
sub prototype() :method { my $self = shift; return $self->{prototype} ||= $self->_build_prototype } ## no critic (ProhibitBuiltinHomonyms) |
|
73
|
|
|
|
|
356
|
|
134
|
73
|
|
100
|
73
|
1
|
4754
|
sub attribute() { my $self = shift; return $self->{attribute} ||= $self->_build_attribute } |
|
73
|
|
|
|
|
341
|
|
135
|
49
|
|
100
|
49
|
1
|
6173
|
sub is_constant() { my $self = shift; return $self->{is_constant} ||= !!$self->_build_is_constant } |
|
49
|
|
|
|
|
337
|
|
136
|
337
|
|
|
337
|
1
|
5617
|
sub is_method() { my $self = shift; return !!$self->{is_method} } |
|
337
|
|
|
|
|
1810
|
|
137
|
391
|
|
|
391
|
1
|
6485
|
sub parameters() { my $self = shift; return $self->{parameters} } |
|
391
|
|
|
|
|
1997
|
|
138
|
185
|
|
|
185
|
1
|
9087
|
sub returns() { my $self = shift; return $self->{returns} } |
|
185
|
|
|
|
|
1151
|
|
139
|
|
|
|
|
|
|
|
140
|
4
|
|
|
4
|
1
|
10
|
sub args() { my $self = shift; return $self->parameters->args } |
|
4
|
|
|
|
|
9
|
|
141
|
2
|
|
|
2
|
1
|
10
|
sub all_args() { my $self = shift; return $self->parameters->all_args } |
|
2
|
|
|
|
|
6
|
|
142
|
2
|
|
|
2
|
1
|
5
|
sub slurpy() { my $self = shift; return $self->parameters->slurpy } |
|
2
|
|
|
|
|
5
|
|
143
|
2
|
|
|
2
|
1
|
8
|
sub nshift() { my $self = shift; return $self->parameters->nshift } |
|
2
|
|
|
|
|
7
|
|
144
|
2
|
|
|
2
|
1
|
5
|
sub invocant() { my $self = shift; return $self->parameters->invocant } |
|
2
|
|
|
|
|
5
|
|
145
|
1
|
|
|
1
|
1
|
3
|
sub invocants() { my $self = shift; return $self->parameters->invocants } |
|
1
|
|
|
|
|
3
|
|
146
|
|
|
|
|
|
|
|
147
|
26
|
|
|
26
|
1
|
4860
|
sub has_sub() { my $self = shift; return defined $self->{sub} } |
|
26
|
|
|
|
|
78
|
|
148
|
232
|
|
|
232
|
1
|
5139
|
sub has_subname() { my $self = shift; return defined $self->subinfo->[1] } |
|
232
|
|
|
|
|
446
|
|
149
|
65
|
|
|
65
|
1
|
5063
|
sub has_stashname() { my $self = shift; return defined $self->subinfo->[0] } |
|
65
|
|
|
|
|
144
|
|
150
|
26
|
|
|
26
|
1
|
4892
|
sub has_prototype() { my $self = shift; return !!$self->prototype } # after build_prototype |
|
26
|
|
|
|
|
83
|
|
151
|
26
|
|
|
26
|
1
|
4990
|
sub has_attribute() { my $self = shift; return !!$self->attribute } # after build_attribute |
|
26
|
|
|
|
|
84
|
|
152
|
155
|
|
|
155
|
1
|
5256
|
sub has_parameters() { my $self = shift; return defined $self->{parameters} } |
|
155
|
|
|
|
|
681
|
|
153
|
131
|
|
|
131
|
1
|
5156
|
sub has_returns() { my $self = shift; return defined $self->{returns} } |
|
131
|
|
|
|
|
428
|
|
154
|
26
|
|
|
26
|
1
|
5007
|
sub has_file() { my $self = shift; return defined $self->{file} } |
|
26
|
|
|
|
|
100
|
|
155
|
26
|
|
|
26
|
1
|
4949
|
sub has_line() { my $self = shift; return defined $self->{line} } |
|
26
|
|
|
|
|
81
|
|
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
sub set_sub { |
158
|
20
|
|
|
20
|
1
|
59
|
my ($self, $v) = @_; |
159
|
20
|
|
|
|
|
132
|
$self->{sub} = $v; |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
# rebuild |
162
|
20
|
|
|
|
|
51
|
for (qw/subinfo file line prototype attribute is_constant/) { |
163
|
120
|
|
|
|
|
762
|
delete $self->{$_}; |
164
|
120
|
|
|
|
|
280
|
$self->$_; |
165
|
|
|
|
|
|
|
} |
166
|
20
|
|
|
|
|
52
|
return $self; |
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
|
169
|
57
|
|
|
57
|
1
|
123
|
sub set_subname { my ($self, $v) = @_; $self->{subinfo}[1] = $v; return $self } |
|
57
|
|
|
|
|
195
|
|
|
57
|
|
|
|
|
91
|
|
170
|
2
|
|
|
2
|
1
|
13
|
sub set_stashname { my ($self, $v) = @_; $self->{subinfo}[0] = $v; return $self } |
|
2
|
|
|
|
|
7
|
|
|
2
|
|
|
|
|
11
|
|
171
|
|
|
|
|
|
|
sub set_fullname { |
172
|
14
|
|
|
14
|
1
|
8971
|
my ($self, $v) = @_; |
173
|
14
|
100
|
|
|
|
131
|
$self->set_subinfo($v =~ m!^(.+)::([^:]+)$! ? [$1, $2] : []); |
174
|
14
|
|
|
|
|
61
|
return $self; |
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
sub set_subinfo { |
177
|
25
|
|
|
25
|
1
|
2806
|
my ($self, $args) = @_; |
178
|
25
|
|
|
|
|
94
|
$self->{subinfo} = [ $args->[0], $args->[1] ]; |
179
|
22
|
|
|
|
|
60
|
return $self; |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
|
182
|
1
|
|
|
1
|
1
|
9
|
sub set_file { my ($self, $v) = @_; $self->{file} = $v; return $self } |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
8
|
|
183
|
1
|
|
|
1
|
1
|
8
|
sub set_line { my ($self, $v) = @_; $self->{line} = $v; return $self } |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
7
|
|
184
|
1
|
|
|
1
|
1
|
9
|
sub set_is_constant { my ($self, $v) = @_; $self->{is_constant} = $v; return $self } |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
8
|
|
185
|
3
|
|
|
3
|
1
|
14
|
sub set_prototype { my ($self, $v) = @_; $self->{prototype} = $v; return $self } |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
9
|
|
186
|
3
|
|
|
3
|
1
|
54
|
sub set_attribute { my ($self, $v) = @_; $self->{attribute} = $v; return $self } |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
10
|
|
187
|
13
|
|
|
13
|
1
|
37
|
sub set_is_method { my ($self, $v) = @_; $self->{is_method} = $v; return $self } |
|
13
|
|
|
|
|
31
|
|
|
13
|
|
|
|
|
31
|
|
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
sub set_parameters { |
190
|
57
|
|
|
57
|
1
|
2503
|
my ($self, @args) = @_; |
191
|
57
|
|
|
|
|
86
|
my $v = $args[0]; |
192
|
57
|
100
|
|
|
|
212
|
if (Scalar::Util::blessed($v)) { |
193
|
30
|
100
|
|
|
|
142
|
if ($v->isa('Sub::Meta::Parameters')) { |
194
|
29
|
|
|
|
|
54
|
$self->{parameters} = $v |
195
|
|
|
|
|
|
|
} |
196
|
|
|
|
|
|
|
else { |
197
|
1
|
|
|
|
|
5
|
_croak('object must be Sub::Meta::Parameters'); |
198
|
|
|
|
|
|
|
} |
199
|
|
|
|
|
|
|
} |
200
|
|
|
|
|
|
|
else { |
201
|
27
|
|
|
|
|
88
|
$self->{parameters} = $self->parameters_class->new(@args); |
202
|
|
|
|
|
|
|
} |
203
|
53
|
|
|
|
|
126
|
return $self |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
sub set_args { |
207
|
4
|
|
|
4
|
1
|
268
|
my ($self, $args) = @_; |
208
|
4
|
100
|
|
|
|
10
|
if ($self->has_parameters) { |
209
|
2
|
|
|
|
|
6
|
$self->parameters->set_args($args); |
210
|
|
|
|
|
|
|
} |
211
|
|
|
|
|
|
|
else { |
212
|
2
|
|
|
|
|
6
|
$self->set_parameters($self->parameters_class->new(args => $args)); |
213
|
|
|
|
|
|
|
} |
214
|
4
|
|
|
|
|
20
|
return $self; |
215
|
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
sub set_slurpy { |
218
|
3
|
|
|
3
|
1
|
25
|
my ($self, @args) = @_; |
219
|
3
|
|
|
|
|
9
|
$self->parameters->set_slurpy(@args); |
220
|
2
|
|
|
|
|
8
|
return $self; |
221
|
|
|
|
|
|
|
} |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
sub set_nshift { |
224
|
3
|
|
|
3
|
1
|
24
|
my ($self, $v) = @_; |
225
|
3
|
100
|
100
|
|
|
8
|
if ($self->is_method && $v == 0) { |
226
|
1
|
|
|
|
|
3
|
_croak 'nshift of method cannot be zero'; |
227
|
|
|
|
|
|
|
} |
228
|
2
|
|
|
|
|
6
|
$self->parameters->set_nshift($v); |
229
|
2
|
|
|
|
|
4
|
return $self; |
230
|
|
|
|
|
|
|
} |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
sub set_invocant { |
233
|
1
|
|
|
1
|
1
|
4
|
my ($self, $v) = @_; |
234
|
1
|
|
|
|
|
3
|
$self->parameters->set_invocant($v); |
235
|
1
|
|
|
|
|
4
|
return $self; |
236
|
|
|
|
|
|
|
} |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
sub set_returns { |
239
|
25
|
|
|
25
|
1
|
69
|
my ($self, @args) = @_; |
240
|
25
|
|
|
|
|
42
|
my $v = $args[0]; |
241
|
25
|
100
|
100
|
|
|
173
|
if (Scalar::Util::blessed($v) && $v->isa('Sub::Meta::Returns')) { |
242
|
21
|
|
|
|
|
44
|
$self->{returns} = $v |
243
|
|
|
|
|
|
|
} |
244
|
|
|
|
|
|
|
else { |
245
|
4
|
|
|
|
|
14
|
$self->{returns} = $self->returns_class->new(@args); |
246
|
|
|
|
|
|
|
} |
247
|
25
|
|
|
|
|
63
|
return $self |
248
|
|
|
|
|
|
|
} |
249
|
|
|
|
|
|
|
|
250
|
65
|
100
|
|
65
|
|
123
|
sub _build_subinfo { my $self = shift; return $self->sub ? [ Sub::Identify::get_code_info($self->sub) ] : [] } |
|
65
|
|
|
|
|
160
|
|
251
|
38
|
100
|
|
38
|
|
69
|
sub _build_file { my $self = shift; return $self->sub ? (Sub::Identify::get_code_location($self->sub))[0] : undef } |
|
38
|
|
|
|
|
119
|
|
252
|
38
|
100
|
|
38
|
|
70
|
sub _build_line { my $self = shift; return $self->sub ? (Sub::Identify::get_code_location($self->sub))[1] : undef } |
|
38
|
|
|
|
|
82
|
|
253
|
46
|
100
|
|
46
|
|
96
|
sub _build_is_constant { my $self = shift; return $self->sub ? Sub::Identify::is_sub_constant($self->sub) : undef } |
|
46
|
|
|
|
|
126
|
|
254
|
62
|
100
|
|
62
|
|
102
|
sub _build_prototype { my $self = shift; return $self->sub ? Sub::Util::prototype($self->sub) : undef } |
|
62
|
|
|
|
|
140
|
|
255
|
58
|
100
|
|
58
|
|
118
|
sub _build_attribute { my $self = shift; return $self->sub ? [ attributes::get($self->sub) ] : undef } |
|
58
|
|
|
|
|
166
|
|
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
sub apply_subname { |
258
|
3
|
|
|
3
|
1
|
10
|
my ($self, $subname) = @_; |
259
|
3
|
100
|
|
|
|
8
|
_croak 'apply_subname requires subroutine reference' unless $self->sub; |
260
|
2
|
|
|
|
|
7
|
$self->set_subname($subname); |
261
|
2
|
|
|
|
|
14
|
Sub::Util::set_subname($self->fullname, $self->sub); |
262
|
2
|
|
|
|
|
8
|
return $self; |
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
sub apply_prototype { |
266
|
3
|
|
|
3
|
1
|
10
|
my ($self, $prototype) = @_; |
267
|
3
|
100
|
|
|
|
7
|
_croak 'apply_prototype requires subroutine reference' unless $self->sub; |
268
|
2
|
|
|
|
|
5
|
Sub::Util::set_prototype($prototype, $self->sub); |
269
|
2
|
|
|
|
|
7
|
$self->set_prototype($prototype); |
270
|
2
|
|
|
|
|
6
|
return $self; |
271
|
|
|
|
|
|
|
} |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
sub apply_attribute { |
274
|
4
|
|
|
4
|
1
|
35
|
my ($self, @attribute) = @_; |
275
|
4
|
100
|
|
|
|
8
|
_croak 'apply_attribute requires subroutine reference' unless $self->sub; |
276
|
|
|
|
|
|
|
{ |
277
|
20
|
|
|
20
|
|
56548
|
no warnings qw(misc); ## no critic (ProhibitNoWarnings) |
|
20
|
|
|
|
|
57
|
|
|
20
|
|
|
|
|
24038
|
|
|
3
|
|
|
|
|
8
|
|
278
|
3
|
|
|
|
|
8
|
attributes->import($self->stashname, $self->sub, @attribute); |
279
|
|
|
|
|
|
|
} |
280
|
2
|
|
|
|
|
191
|
$self->set_attribute($self->_build_attribute); |
281
|
2
|
|
|
|
|
8
|
return $self; |
282
|
|
|
|
|
|
|
} |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
sub apply_meta { |
285
|
1
|
|
|
1
|
1
|
6
|
my ($self, $other) = @_; |
286
|
|
|
|
|
|
|
|
287
|
1
|
|
|
|
|
3
|
$self->apply_subname($other->subname); |
288
|
1
|
|
|
|
|
3
|
$self->apply_prototype($other->prototype); |
289
|
1
|
|
|
|
|
3
|
$self->apply_attribute(@{$other->attribute}); |
|
1
|
|
|
|
|
3
|
|
290
|
|
|
|
|
|
|
|
291
|
1
|
|
|
|
|
6
|
return $self; |
292
|
|
|
|
|
|
|
} |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
sub is_same_interface { |
295
|
39
|
|
|
39
|
1
|
67
|
my ($self, $other) = @_; |
296
|
|
|
|
|
|
|
|
297
|
39
|
100
|
100
|
|
|
273
|
return unless Scalar::Util::blessed($other) && $other->isa('Sub::Meta'); |
298
|
|
|
|
|
|
|
|
299
|
37
|
100
|
|
|
|
96
|
if ($self->has_subname) { |
300
|
23
|
100
|
|
|
|
51
|
return unless $self->subname eq $other->subname |
301
|
|
|
|
|
|
|
} |
302
|
|
|
|
|
|
|
else { |
303
|
14
|
100
|
|
|
|
30
|
return if $other->has_subname; |
304
|
|
|
|
|
|
|
} |
305
|
|
|
|
|
|
|
|
306
|
30
|
100
|
|
|
|
69
|
return unless $self->is_method eq $other->is_method; |
307
|
|
|
|
|
|
|
|
308
|
25
|
100
|
|
|
|
44
|
if ($self->has_parameters) { |
309
|
12
|
100
|
|
|
|
22
|
return unless $self->parameters->is_same_interface($other->parameters) |
310
|
|
|
|
|
|
|
} |
311
|
|
|
|
|
|
|
else { |
312
|
13
|
100
|
|
|
|
23
|
return if $other->has_parameters; |
313
|
|
|
|
|
|
|
} |
314
|
|
|
|
|
|
|
|
315
|
19
|
100
|
|
|
|
39
|
if ($self->has_returns) { |
316
|
8
|
100
|
|
|
|
15
|
return unless $self->returns->is_same_interface($other->returns) |
317
|
|
|
|
|
|
|
} |
318
|
|
|
|
|
|
|
else { |
319
|
11
|
100
|
|
|
|
21
|
return if $other->has_returns; |
320
|
|
|
|
|
|
|
} |
321
|
|
|
|
|
|
|
|
322
|
14
|
|
|
|
|
39
|
return !!1; |
323
|
|
|
|
|
|
|
} |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
sub is_relaxed_same_interface { |
326
|
39
|
|
|
39
|
1
|
72
|
my ($self, $other) = @_; |
327
|
|
|
|
|
|
|
|
328
|
39
|
100
|
100
|
|
|
202
|
return unless Scalar::Util::blessed($other) && $other->isa('Sub::Meta'); |
329
|
|
|
|
|
|
|
|
330
|
37
|
100
|
|
|
|
79
|
if ($self->has_subname) { |
331
|
23
|
100
|
|
|
|
48
|
return unless $self->subname eq $other->subname |
332
|
|
|
|
|
|
|
} |
333
|
|
|
|
|
|
|
|
334
|
34
|
100
|
|
|
|
73
|
return unless $self->is_method eq $other->is_method; |
335
|
|
|
|
|
|
|
|
336
|
29
|
100
|
|
|
|
57
|
if ($self->has_parameters) { |
337
|
14
|
100
|
|
|
|
29
|
return unless $self->parameters->is_relaxed_same_interface($other->parameters) |
338
|
|
|
|
|
|
|
} |
339
|
|
|
|
|
|
|
|
340
|
24
|
100
|
|
|
|
88
|
if ($self->has_returns) { |
341
|
10
|
100
|
|
|
|
21
|
return unless $self->returns->is_relaxed_same_interface($other->returns) |
342
|
|
|
|
|
|
|
} |
343
|
|
|
|
|
|
|
|
344
|
21
|
|
|
|
|
52
|
return !!1; |
345
|
|
|
|
|
|
|
} |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
sub is_same_interface_inlined { |
348
|
9
|
|
|
9
|
1
|
20
|
my ($self, $v) = @_; |
349
|
|
|
|
|
|
|
|
350
|
9
|
|
|
|
|
16
|
my @src; |
351
|
|
|
|
|
|
|
|
352
|
9
|
|
|
|
|
57
|
push @src => sprintf("Scalar::Util::blessed(%s) && %s->isa('Sub::Meta')", $v, $v); |
353
|
|
|
|
|
|
|
|
354
|
9
|
100
|
|
|
|
29
|
push @src => $self->has_subname ? sprintf("'%s' eq %s->subname", $self->subname, $v) |
355
|
|
|
|
|
|
|
: sprintf('!%s->has_subname', $v); |
356
|
|
|
|
|
|
|
|
357
|
9
|
|
|
|
|
29
|
push @src => sprintf("'%s' eq %s->is_method", $self->is_method, $v); |
358
|
|
|
|
|
|
|
|
359
|
9
|
100
|
|
|
|
30
|
push @src => $self->has_parameters ? $self->parameters->is_same_interface_inlined(sprintf('%s->parameters', $v)) |
360
|
|
|
|
|
|
|
: sprintf('!%s->has_parameters', $v); |
361
|
|
|
|
|
|
|
|
362
|
9
|
100
|
|
|
|
25
|
push @src => $self->has_returns ? $self->returns->is_same_interface_inlined(sprintf('%s->returns', $v)) |
363
|
|
|
|
|
|
|
: sprintf('!%s->has_returns', $v); |
364
|
|
|
|
|
|
|
|
365
|
9
|
|
|
|
|
2179
|
return join "\n && ", @src; |
366
|
|
|
|
|
|
|
} |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
sub is_relaxed_same_interface_inlined { |
369
|
9
|
|
|
9
|
1
|
27
|
my ($self, $v) = @_; |
370
|
|
|
|
|
|
|
|
371
|
9
|
|
|
|
|
15
|
my @src; |
372
|
|
|
|
|
|
|
|
373
|
9
|
|
|
|
|
47
|
push @src => sprintf("Scalar::Util::blessed(%s) && %s->isa('Sub::Meta')", $v, $v); |
374
|
|
|
|
|
|
|
|
375
|
9
|
100
|
|
|
|
26
|
push @src => sprintf("'%s' eq %s->subname", $self->subname, $v) if $self->has_subname; |
376
|
|
|
|
|
|
|
|
377
|
9
|
|
|
|
|
29
|
push @src => sprintf("'%s' eq %s->is_method", $self->is_method, $v); |
378
|
|
|
|
|
|
|
|
379
|
9
|
100
|
|
|
|
33
|
push @src => $self->parameters->is_relaxed_same_interface_inlined(sprintf('%s->parameters', $v)) if $self->has_parameters; |
380
|
|
|
|
|
|
|
|
381
|
9
|
100
|
|
|
|
27
|
push @src => $self->returns->is_relaxed_same_interface_inlined(sprintf('%s->returns', $v)) if $self->has_returns; |
382
|
|
|
|
|
|
|
|
383
|
9
|
|
|
|
|
1622
|
return join "\n && ", @src; |
384
|
|
|
|
|
|
|
} |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
sub error_message { |
387
|
20
|
|
|
20
|
1
|
37
|
my ($self, $other) = @_; |
388
|
|
|
|
|
|
|
|
389
|
20
|
100
|
100
|
|
|
156
|
return sprintf('must be Sub::Meta. got: %s', $other // '') |
|
|
|
100
|
|
|
|
|
390
|
|
|
|
|
|
|
unless Scalar::Util::blessed($other) && $other->isa('Sub::Meta'); |
391
|
|
|
|
|
|
|
|
392
|
18
|
100
|
|
|
|
54
|
if ($self->has_subname) { |
393
|
7
|
100
|
|
|
|
15
|
return sprintf('invalid subname. got: %s, expected: %s', $other->subname, $self->subname) |
394
|
|
|
|
|
|
|
unless $self->subname eq $other->subname |
395
|
|
|
|
|
|
|
} |
396
|
|
|
|
|
|
|
else { |
397
|
11
|
100
|
|
|
|
23
|
return sprintf('should not have subname. got: %s', $other->subname) if $other->has_subname; |
398
|
|
|
|
|
|
|
} |
399
|
|
|
|
|
|
|
|
400
|
15
|
100
|
|
|
|
39
|
if ($self->is_method ne $other->is_method) { |
401
|
2
|
|
|
|
|
6
|
return 'invalid method'; |
402
|
|
|
|
|
|
|
} |
403
|
|
|
|
|
|
|
|
404
|
13
|
100
|
|
|
|
60
|
if ($self->has_parameters) { |
405
|
3
|
100
|
|
|
|
8
|
return "invalid parameters:" . $self->parameters->error_message($other->parameters) |
406
|
|
|
|
|
|
|
unless $self->parameters->is_same_interface($other->parameters) |
407
|
|
|
|
|
|
|
} |
408
|
|
|
|
|
|
|
else { |
409
|
10
|
100
|
|
|
|
21
|
return 'should not have parameters' if $other->parameters; |
410
|
|
|
|
|
|
|
} |
411
|
|
|
|
|
|
|
|
412
|
10
|
100
|
|
|
|
23
|
if ($self->has_returns) { |
413
|
3
|
100
|
|
|
|
8
|
return "invalid returns:" . $self->returns->error_message($other->returns) |
414
|
|
|
|
|
|
|
unless $self->returns->is_same_interface($other->returns) |
415
|
|
|
|
|
|
|
} |
416
|
|
|
|
|
|
|
else { |
417
|
7
|
100
|
|
|
|
18
|
return 'should not have returns' if $other->returns; |
418
|
|
|
|
|
|
|
} |
419
|
7
|
|
|
|
|
18
|
return ''; |
420
|
|
|
|
|
|
|
} |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
sub relaxed_error_message { |
423
|
20
|
|
|
20
|
1
|
37
|
my ($self, $other) = @_; |
424
|
|
|
|
|
|
|
|
425
|
20
|
100
|
100
|
|
|
117
|
return sprintf('must be Sub::Meta. got: %s', $other // '') |
|
|
|
100
|
|
|
|
|
426
|
|
|
|
|
|
|
unless Scalar::Util::blessed($other) && $other->isa('Sub::Meta'); |
427
|
|
|
|
|
|
|
|
428
|
18
|
100
|
|
|
|
47
|
if ($self->has_subname) { |
429
|
7
|
100
|
|
|
|
16
|
return sprintf('invalid subname. got: %s, expected: %s', $other->subname, $self->subname) |
430
|
|
|
|
|
|
|
unless $self->subname eq $other->subname |
431
|
|
|
|
|
|
|
} |
432
|
|
|
|
|
|
|
|
433
|
16
|
100
|
|
|
|
34
|
if ($self->is_method ne $other->is_method) { |
434
|
2
|
|
|
|
|
6
|
return 'invalid method' |
435
|
|
|
|
|
|
|
} |
436
|
|
|
|
|
|
|
|
437
|
14
|
100
|
|
|
|
32
|
if ($self->has_parameters) { |
438
|
3
|
100
|
|
|
|
7
|
return "invalid parameters:" . $self->parameters->relaxed_error_message($other->parameters) |
439
|
|
|
|
|
|
|
unless $self->parameters->is_relaxed_same_interface($other->parameters) |
440
|
|
|
|
|
|
|
} |
441
|
|
|
|
|
|
|
|
442
|
12
|
100
|
|
|
|
25
|
if ($self->has_returns) { |
443
|
3
|
100
|
|
|
|
7
|
return "invalid returns:" . $self->returns->relaxed_error_message($other->returns) |
444
|
|
|
|
|
|
|
unless $self->returns->is_relaxed_same_interface($other->returns) |
445
|
|
|
|
|
|
|
} |
446
|
10
|
|
|
|
|
23
|
return ''; |
447
|
|
|
|
|
|
|
} |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
sub display { |
450
|
15
|
|
|
15
|
1
|
26
|
my $self = shift; |
451
|
|
|
|
|
|
|
|
452
|
15
|
100
|
|
|
|
30
|
my $keyword = $self->is_method ? 'method' : 'sub'; |
453
|
15
|
|
|
|
|
38
|
my $subname = $self->subname; |
454
|
|
|
|
|
|
|
|
455
|
15
|
|
|
|
|
27
|
my $s = $keyword; |
456
|
15
|
100
|
|
|
|
40
|
$s .= ' ' . $subname if $subname; |
457
|
15
|
100
|
|
|
|
29
|
$s .= '('. $self->parameters->display .')' if $self->parameters; |
458
|
15
|
100
|
|
|
|
35
|
$s .= ' => ' . $self->returns->display if $self->returns; |
459
|
15
|
|
|
|
|
86
|
return $s; |
460
|
|
|
|
|
|
|
} |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
1; |
463
|
|
|
|
|
|
|
__END__ |