line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Evo::Class::Meta; |
2
|
41
|
|
|
41
|
|
17167
|
use Evo 'Carp croak; Scalar::Util reftype; -Internal::Util; Module::Load ()'; |
|
41
|
|
|
|
|
89
|
|
|
41
|
|
|
|
|
219
|
|
3
|
41
|
|
|
41
|
|
248
|
use Evo '/::Attrs *; /::Syntax *'; |
|
41
|
|
|
|
|
82
|
|
|
41
|
|
|
|
|
149
|
|
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
our @CARP_NOT = qw(Evo::Class); |
6
|
|
|
|
|
|
|
|
7
|
203
|
50
|
|
203
|
1
|
1326
|
sub register ($me, $package) { |
|
203
|
50
|
|
|
|
560
|
|
|
203
|
|
|
|
|
385
|
|
|
203
|
|
|
|
|
322
|
|
|
203
|
|
|
|
|
321
|
|
8
|
41
|
|
|
41
|
|
289
|
no strict 'refs'; ## no critic |
|
41
|
|
|
|
|
85
|
|
|
41
|
|
|
|
|
1194
|
|
9
|
41
|
|
|
41
|
|
228
|
no warnings 'once'; |
|
41
|
|
|
|
|
103
|
|
|
41
|
|
|
|
|
5617
|
|
10
|
|
|
|
|
|
|
|
11
|
203
|
|
66
|
|
|
306
|
${"${package}::EVO_CLASS_ATTRS"} ||= Evo::Class::Attrs->new; |
|
203
|
|
|
|
|
2092
|
|
12
|
|
|
|
|
|
|
|
13
|
203
|
|
100
|
|
|
338
|
${"${package}::EVO_CLASS_META"} |
|
203
|
|
|
|
|
1965
|
|
14
|
|
|
|
|
|
|
||= bless {package => $package, private => {}, methods => {}, reqs => {}, overridden => {}}, |
15
|
|
|
|
|
|
|
$me; |
16
|
|
|
|
|
|
|
} |
17
|
|
|
|
|
|
|
|
18
|
516
|
50
|
|
516
|
0
|
1301
|
sub find_or_croak ($self, $package) { |
|
516
|
50
|
|
|
|
1201
|
|
|
516
|
|
|
|
|
835
|
|
|
516
|
|
|
|
|
767
|
|
|
516
|
|
|
|
|
760
|
|
19
|
41
|
|
|
41
|
|
247
|
no strict 'refs'; ## no critic |
|
41
|
|
|
|
|
84
|
|
|
41
|
|
|
|
|
5754
|
|
20
|
516
|
100
|
|
|
|
751
|
${"${package}::EVO_CLASS_META"} |
|
516
|
|
|
|
|
3061
|
|
21
|
|
|
|
|
|
|
or croak qq#$package isn't Evo::Class; "use parent '$package';" for external classes#; |
22
|
|
|
|
|
|
|
} |
23
|
|
|
|
|
|
|
|
24
|
4322
|
50
|
|
4322
|
0
|
8502
|
sub package($self) { $self->{package} } |
|
4322
|
50
|
|
|
|
8162
|
|
|
4322
|
|
|
|
|
5684
|
|
|
4322
|
|
|
|
|
5396
|
|
|
4322
|
|
|
|
|
7341
|
|
25
|
|
|
|
|
|
|
|
26
|
1862
|
50
|
|
1862
|
1
|
6861
|
sub attrs($self) { |
|
1862
|
50
|
|
|
|
3753
|
|
|
1862
|
|
|
|
|
2538
|
|
|
1862
|
|
|
|
|
2423
|
|
27
|
41
|
|
|
41
|
|
234
|
no strict 'refs'; ## no critic |
|
41
|
|
|
|
|
80
|
|
|
41
|
|
|
|
|
18423
|
|
28
|
1862
|
|
|
|
|
2812
|
my $package = $self->{package}; |
29
|
1862
|
|
|
|
|
2551
|
${"${package}::EVO_CLASS_ATTRS"}; |
|
1862
|
|
|
|
|
11986
|
|
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
|
32
|
2767
|
50
|
|
2767
|
0
|
5317
|
sub methods($self) { $self->{methods} } |
|
2767
|
50
|
|
|
|
5188
|
|
|
2767
|
|
|
|
|
3639
|
|
|
2767
|
|
|
|
|
3471
|
|
|
2767
|
|
|
|
|
6484
|
|
33
|
89
|
50
|
|
89
|
0
|
304
|
sub reqs($self) { $self->{reqs} } |
|
89
|
50
|
|
|
|
323
|
|
|
89
|
|
|
|
|
280
|
|
|
89
|
|
|
|
|
258
|
|
|
89
|
|
|
|
|
367
|
|
34
|
|
|
|
|
|
|
|
35
|
331
|
50
|
|
331
|
1
|
691
|
sub overridden($self) { $self->{overridden} } |
|
331
|
50
|
|
|
|
658
|
|
|
331
|
|
|
|
|
463
|
|
|
331
|
|
|
|
|
457
|
|
|
331
|
|
|
|
|
840
|
|
36
|
1840
|
50
|
|
1840
|
1
|
3520
|
sub private($self) { $self->{private} } |
|
1840
|
50
|
|
|
|
3382
|
|
|
1840
|
|
|
|
|
2369
|
|
|
1840
|
|
|
|
|
2316
|
|
|
1840
|
|
|
|
|
5187
|
|
37
|
|
|
|
|
|
|
|
38
|
16
|
50
|
|
16
|
0
|
1369
|
sub mark_as_overridden ($self, $name) { |
|
16
|
50
|
|
|
|
46
|
|
|
16
|
|
|
|
|
30
|
|
|
16
|
|
|
|
|
34
|
|
|
16
|
|
|
|
|
28
|
|
39
|
16
|
|
|
|
|
122
|
$self->overridden->{$name} = 1; |
40
|
16
|
|
|
|
|
37
|
$self; |
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
|
43
|
314
|
50
|
|
314
|
0
|
710
|
sub is_overridden ($self, $name) { |
|
314
|
50
|
|
|
|
630
|
|
|
314
|
|
|
|
|
422
|
|
|
314
|
|
|
|
|
454
|
|
|
314
|
|
|
|
|
414
|
|
44
|
314
|
|
|
|
|
586
|
$self->overridden->{$name}; |
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
|
47
|
15
|
50
|
|
15
|
1
|
889
|
sub mark_as_private ($self, $name) { |
|
15
|
50
|
|
|
|
49
|
|
|
15
|
|
|
|
|
31
|
|
|
15
|
|
|
|
|
27
|
|
|
15
|
|
|
|
|
25
|
|
48
|
15
|
|
|
|
|
44
|
$self->private->{$name} = 1; |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
|
51
|
1824
|
50
|
|
1824
|
0
|
3650
|
sub is_private ($self, $name) { |
|
1824
|
50
|
|
|
|
3396
|
|
|
1824
|
|
|
|
|
2425
|
|
|
1824
|
|
|
|
|
2405
|
|
|
1824
|
|
|
|
|
2236
|
|
52
|
1824
|
|
|
|
|
3008
|
$self->private->{$name}; |
53
|
|
|
|
|
|
|
} |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
# first check methods (marked as method or inherited), if doesn't exists, try to determine if there is a sub in package |
56
|
|
|
|
|
|
|
# if a sub is compiled in the same package, it's a public, if not(imported or xsub), and not exported function - it's private |
57
|
|
|
|
|
|
|
|
58
|
2551
|
50
|
|
2551
|
0
|
6782
|
sub is_method ($self, $name) { |
|
2551
|
50
|
|
|
|
4898
|
|
|
2551
|
|
|
|
|
3419
|
|
|
2551
|
|
|
|
|
3400
|
|
|
2551
|
|
|
|
|
3186
|
|
59
|
2551
|
100
|
|
|
|
4364
|
return 1 if $self->methods->{$name}; |
60
|
2525
|
|
|
|
|
4440
|
my $pkg = $self->package; |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
{ |
63
|
41
|
|
|
41
|
|
266
|
no strict 'refs'; ## no critic |
|
41
|
|
|
|
|
83
|
|
|
41
|
|
|
|
|
1074
|
|
|
2525
|
|
|
|
|
3511
|
|
64
|
41
|
|
|
41
|
|
208
|
no warnings 'once'; |
|
41
|
|
|
|
|
77
|
|
|
41
|
|
|
|
|
48943
|
|
65
|
2525
|
|
|
|
|
3311
|
my $meta = ${"${pkg}::EVO_EXPORT_META"}; |
|
2525
|
|
|
|
|
5559
|
|
66
|
2525
|
100
|
66
|
|
|
5207
|
return if $meta && $meta->symbols->{$name}; |
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
|
69
|
2523
|
100
|
|
|
|
5537
|
my $code = Evo::Internal::Util::names2code($pkg, $name) or return; |
70
|
1469
|
|
|
|
|
3177
|
my ($realpkg, $realname, $xsub) = Evo::Internal::Util::code2names($code); |
71
|
1469
|
|
100
|
|
|
7577
|
return !$xsub && $realpkg eq $pkg; |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
|
74
|
1234
|
50
|
|
1234
|
0
|
4690
|
sub is_attr ($self, $name) { |
|
1234
|
50
|
|
|
|
2473
|
|
|
1234
|
|
|
|
|
1689
|
|
|
1234
|
|
|
|
|
1680
|
|
|
1234
|
|
|
|
|
1571
|
|
75
|
1234
|
|
|
|
|
2252
|
$self->attrs->exists($name); |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
|
78
|
722
|
50
|
|
722
|
|
1542
|
sub _check_valid_name ($self, $name) { |
|
722
|
50
|
|
|
|
1491
|
|
|
722
|
|
|
|
|
1005
|
|
|
722
|
|
|
|
|
1097
|
|
|
722
|
|
|
|
|
959
|
|
79
|
722
|
100
|
|
|
|
1749
|
croak(qq{"$name" is invalid name}) unless Evo::Internal::Util::check_subname($name); |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
|
82
|
920
|
50
|
|
920
|
|
1984
|
sub _check_exists ($self, $name) { |
|
920
|
50
|
|
|
|
1888
|
|
|
920
|
|
|
|
|
1311
|
|
|
920
|
|
|
|
|
1275
|
|
|
920
|
|
|
|
|
1202
|
|
83
|
920
|
|
|
|
|
1749
|
my $pkg = $self->package; |
84
|
920
|
100
|
|
|
|
1879
|
croak qq{$pkg already has attribute "$name"} if $self->is_attr($name); |
85
|
915
|
100
|
|
|
|
2117
|
croak qq{$pkg already has method "$name"} if $self->is_method($name); |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
|
88
|
714
|
50
|
|
714
|
|
1598
|
sub _check_exists_valid_name ($self, $name) { |
|
714
|
50
|
|
|
|
1545
|
|
|
714
|
|
|
|
|
1019
|
|
|
714
|
|
|
|
|
1007
|
|
|
714
|
|
|
|
|
946
|
|
89
|
714
|
|
|
|
|
1593
|
_check_valid_name($self, $name); |
90
|
712
|
|
|
|
|
1619
|
_check_exists($self, $name); |
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
|
93
|
493
|
50
|
|
493
|
|
1193
|
sub _reg_parsed_attr ($self, %opts) { |
|
493
|
50
|
|
|
|
1134
|
|
|
493
|
|
|
|
|
728
|
|
|
493
|
|
|
|
|
1816
|
|
|
493
|
|
|
|
|
875
|
|
94
|
493
|
|
|
|
|
810
|
my $name = $opts{name}; |
95
|
493
|
|
|
|
|
1184
|
_check_exists_valid_name($self, $name); |
96
|
487
|
|
|
|
|
1081
|
my $pkg = $self->package; |
97
|
487
|
100
|
|
|
|
1140
|
croak qq{$pkg already has subroutine "$name"} if Evo::Internal::Util::names2code($pkg, $name); |
98
|
|
|
|
|
|
|
|
99
|
484
|
|
|
|
|
1026
|
my $sub = $self->attrs->gen_attr(%opts); # register |
100
|
484
|
100
|
|
|
|
2187
|
Evo::Internal::Util::monkey_patch $pkg, $name, $sub if $opts{method}; |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
|
103
|
8
|
50
|
|
8
|
|
29
|
sub _reg_parsed_attr_over ($self, %opts) { |
|
8
|
50
|
|
|
|
32
|
|
|
8
|
|
|
|
|
12
|
|
|
8
|
|
|
|
|
35
|
|
|
8
|
|
|
|
|
16
|
|
104
|
8
|
|
|
|
|
17
|
my $name = $opts{name}; |
105
|
8
|
|
|
|
|
21
|
_check_valid_name($self, $name); |
106
|
8
|
|
|
|
|
33
|
$self->mark_as_overridden($name); |
107
|
8
|
|
|
|
|
19
|
my $sub = $self->attrs->gen_attr(%opts); # register |
108
|
8
|
|
|
|
|
42
|
my $pkg = $self->package; |
109
|
8
|
100
|
|
|
|
39
|
Evo::Internal::Util::monkey_patch_silent $pkg, $name, $sub if $opts{method}; |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
|
112
|
403
|
50
|
|
403
|
0
|
1324
|
sub reg_attr ($self, $name, @attr) { |
|
403
|
|
|
|
|
621
|
|
|
403
|
|
|
|
|
651
|
|
|
403
|
|
|
|
|
897
|
|
|
403
|
|
|
|
|
642
|
|
113
|
403
|
|
|
|
|
981
|
my %opts = $self->parse_attr($name, @attr); |
114
|
403
|
|
|
|
|
1464
|
$self->_reg_parsed_attr(%opts); |
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
|
117
|
8
|
50
|
|
8
|
0
|
28
|
sub reg_attr_over ($self, $name, @attr) { |
|
8
|
|
|
|
|
14
|
|
|
8
|
|
|
|
|
16
|
|
|
8
|
|
|
|
|
21
|
|
|
8
|
|
|
|
|
15
|
|
118
|
8
|
|
|
|
|
24
|
my %opts = $self->parse_attr($name, @attr); |
119
|
8
|
|
|
|
|
40
|
$self->_reg_parsed_attr_over(%opts); |
120
|
|
|
|
|
|
|
} |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
# means register external sub as method. Because every sub in the current package |
123
|
|
|
|
|
|
|
# is public by default |
124
|
221
|
50
|
|
221
|
1
|
640
|
sub reg_method ($self, $name) { |
|
221
|
50
|
|
|
|
471
|
|
|
221
|
|
|
|
|
313
|
|
|
221
|
|
|
|
|
327
|
|
|
221
|
|
|
|
|
290
|
|
125
|
221
|
|
|
|
|
485
|
_check_exists_valid_name($self, $name); |
126
|
217
|
|
|
|
|
466
|
my $pkg = $self->package; |
127
|
217
|
100
|
|
|
|
483
|
my $code = Evo::Internal::Util::names2code($pkg, $name) or croak "$pkg::$name doesn't exist"; |
128
|
215
|
|
|
|
|
462
|
$self->methods->{$name}++; |
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
|
131
|
57
|
50
|
|
57
|
|
220
|
sub _public_attrs_slots($self) { |
|
57
|
50
|
|
|
|
136
|
|
|
57
|
|
|
|
|
108
|
|
|
57
|
|
|
|
|
149
|
|
132
|
57
|
|
|
|
|
140
|
grep { !$self->is_private($_->{name}) } $self->attrs->slots; |
|
188
|
|
|
|
|
396
|
|
133
|
|
|
|
|
|
|
} |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
# not marked as private |
136
|
|
|
|
|
|
|
# was compiled in the same package, not constant, not exported lib |
137
|
61
|
50
|
|
61
|
|
170
|
sub _public_methods_map($self) { |
|
61
|
50
|
|
|
|
160
|
|
|
61
|
|
|
|
|
105
|
|
|
61
|
|
|
|
|
92
|
|
138
|
61
|
|
|
|
|
126
|
my $pkg = $self->package; |
139
|
435
|
|
|
|
|
883
|
map { ($_, Evo::Internal::Util::names2code($pkg, $_)) } |
140
|
61
|
100
|
|
|
|
290
|
grep { !$self->is_private($_) && $self->is_method($_) } |
|
1634
|
|
|
|
|
3045
|
|
141
|
|
|
|
|
|
|
Evo::Internal::Util::list_symbols($pkg); |
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
|
144
|
26
|
50
|
|
26
|
0
|
1090
|
sub public_attrs($self) { |
|
26
|
50
|
|
|
|
85
|
|
|
26
|
|
|
|
|
75
|
|
|
26
|
|
|
|
|
53
|
|
145
|
26
|
|
|
|
|
67
|
map { $_->{name} } $self->_public_attrs_slots; |
|
92
|
|
|
|
|
216
|
|
146
|
|
|
|
|
|
|
} |
147
|
|
|
|
|
|
|
|
148
|
27
|
50
|
|
27
|
0
|
94
|
sub public_methods($self) { |
|
27
|
50
|
|
|
|
97
|
|
|
27
|
|
|
|
|
69
|
|
|
27
|
|
|
|
|
51
|
|
149
|
27
|
|
|
|
|
82
|
my %map = $self->_public_methods_map; |
150
|
27
|
|
|
|
|
392
|
keys %map; |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
|
154
|
32
|
50
|
|
32
|
0
|
152
|
sub extend_with ($self, $source_p) { |
|
32
|
50
|
|
|
|
98
|
|
|
32
|
|
|
|
|
64
|
|
|
32
|
|
|
|
|
62
|
|
|
32
|
|
|
|
|
58
|
|
155
|
32
|
|
|
|
|
99
|
$source_p = Evo::Internal::Util::resolve_package($self->package, $source_p); |
156
|
32
|
|
|
|
|
170
|
Module::Load::load($source_p); |
157
|
32
|
|
|
|
|
543
|
my $source = $self->find_or_croak($source_p); |
158
|
31
|
|
|
|
|
86
|
my $dest_p = $self->package; |
159
|
31
|
|
|
|
|
84
|
my %reqs = $source->reqs()->%*; |
160
|
31
|
|
|
|
|
108
|
my %methods = $source->_public_methods_map(); |
161
|
|
|
|
|
|
|
|
162
|
31
|
|
|
|
|
137
|
my @new_attrs; |
163
|
31
|
|
|
|
|
160
|
foreach my $name (keys %reqs) { $self->reg_requirement($name); } |
|
14
|
|
|
|
|
199
|
|
164
|
|
|
|
|
|
|
|
165
|
31
|
|
|
|
|
110
|
foreach my $slot ($source->_public_attrs_slots) { |
166
|
93
|
100
|
|
|
|
233
|
next if $self->is_overridden($slot->{name}); |
167
|
90
|
|
|
|
|
353
|
$self->_reg_parsed_attr(%$slot); |
168
|
87
|
|
|
|
|
244
|
push @new_attrs, $slot->{name}; |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
|
171
|
28
|
|
|
|
|
209
|
foreach my $name (keys %methods) { |
172
|
215
|
100
|
|
|
|
449
|
next if $self->is_overridden($name); |
173
|
211
|
100
|
|
|
|
481
|
croak qq/$dest_p already has a subroutine with name "$name"/ |
174
|
|
|
|
|
|
|
if Evo::Internal::Util::names2code($dest_p, $name); |
175
|
208
|
|
|
|
|
540
|
_check_exists($self, $name); # prevent patching before check |
176
|
208
|
|
|
|
|
594
|
Evo::Internal::Util::monkey_patch $dest_p, $name, $methods{$name}; |
177
|
208
|
|
|
|
|
468
|
$self->reg_method($name); |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
|
180
|
41
|
|
|
41
|
|
302
|
no strict 'refs'; ## no critic |
|
41
|
|
|
|
|
87
|
|
|
41
|
|
|
|
|
27110
|
|
181
|
25
|
|
|
|
|
63
|
push @{"${dest_p}::ISA"}, $source_p; |
|
25
|
|
|
|
|
340
|
|
182
|
25
|
|
|
|
|
132
|
@new_attrs; |
183
|
|
|
|
|
|
|
} |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
|
186
|
33
|
50
|
|
33
|
0
|
386
|
sub reg_requirement ($self, $name) { |
|
33
|
50
|
|
|
|
95
|
|
|
33
|
|
|
|
|
63
|
|
|
33
|
|
|
|
|
59
|
|
|
33
|
|
|
|
|
53
|
|
187
|
33
|
|
|
|
|
93
|
$self->reqs->{$name}++; |
188
|
|
|
|
|
|
|
} |
189
|
|
|
|
|
|
|
|
190
|
23
|
50
|
|
23
|
0
|
139
|
sub requirements($self) { |
|
23
|
50
|
|
|
|
70
|
|
|
23
|
|
|
|
|
45
|
|
|
23
|
|
|
|
|
117
|
|
191
|
23
|
|
|
|
|
63
|
(keys($self->reqs->%*), $self->public_attrs, $self->public_methods); |
192
|
|
|
|
|
|
|
} |
193
|
|
|
|
|
|
|
|
194
|
20
|
50
|
|
20
|
1
|
93
|
sub check_implementation ($self, $inter_class) { |
|
20
|
50
|
|
|
|
71
|
|
|
20
|
|
|
|
|
43
|
|
|
20
|
|
|
|
|
37
|
|
|
20
|
|
|
|
|
33
|
|
195
|
20
|
|
|
|
|
54
|
$inter_class = Evo::Internal::Util::resolve_package($self->package, $inter_class); |
196
|
20
|
|
|
|
|
143
|
Module::Load::load($inter_class); |
197
|
20
|
|
|
|
|
1219
|
my $class = $self->package; |
198
|
20
|
|
|
|
|
59
|
my $inter = $self->find_or_croak($inter_class); |
199
|
19
|
|
|
|
|
85
|
my @reqs = sort $inter->requirements; |
200
|
|
|
|
|
|
|
|
201
|
19
|
|
100
|
|
|
66
|
my @not_exists = grep { !($self->is_attr($_) || $class->can($_)); } @reqs; |
|
305
|
|
|
|
|
614
|
|
202
|
19
|
100
|
|
|
|
163
|
return $self if !@not_exists; |
203
|
|
|
|
|
|
|
|
204
|
3
|
|
|
|
|
269
|
croak qq/Bad implementation of "$inter_class", missing in "$class": /, join ';', @not_exists; |
205
|
|
|
|
|
|
|
} |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
# -- class methods for usage from other modules too |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
# rtype: default, default_code, required, lazy, relaxed |
211
|
|
|
|
|
|
|
# rvalue is used as meta for required(di), default and lazy |
212
|
|
|
|
|
|
|
# check? |
213
|
|
|
|
|
|
|
# is_ro? |
214
|
|
|
|
|
|
|
|
215
|
449
|
50
|
|
449
|
0
|
1726
|
sub parse_attr ($me, $name, @attr) { |
|
449
|
|
|
|
|
685
|
|
|
449
|
|
|
|
|
704
|
|
|
449
|
|
|
|
|
917
|
|
|
449
|
|
|
|
|
659
|
|
216
|
449
|
|
|
|
|
807
|
my @scalars = grep { $_ ne SYNTAX_STATE } @attr; |
|
339
|
|
|
|
|
1170
|
|
217
|
449
|
100
|
|
|
|
1318
|
croak "expected 1 scalar, got: " . join ',', @scalars if @scalars > 1; |
218
|
448
|
|
|
|
|
1211
|
my %state = syntax_reset; |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
croak qq#"optional" flag makes no sense with default("$scalars[0]")# |
221
|
448
|
100
|
100
|
|
|
1763
|
if $state{optional} && @scalars; |
222
|
|
|
|
|
|
|
croak qq#"lazy" requires code reference# |
223
|
447
|
100
|
100
|
|
|
1568
|
if $state{lazy} && (reftype($scalars[0]) // '') ne 'CODE'; |
|
|
|
100
|
|
|
|
|
224
|
444
|
100
|
100
|
|
|
1792
|
croak qq#default("$scalars[0]") should be either a scalar or a code reference# |
|
|
|
100
|
|
|
|
|
225
|
|
|
|
|
|
|
if @scalars && ref($scalars[0]) && reftype($scalars[0]) ne 'CODE'; |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
|
228
|
443
|
|
|
|
|
713
|
my $type; |
229
|
443
|
50
|
|
|
|
1316
|
if ($state{optional}) { $type = ECA_OPTIONAL if $state{optional}; } |
|
141
|
100
|
|
|
|
359
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
230
|
14
|
50
|
|
|
|
40
|
elsif ($state{lazy}) { $type = ECA_LAZY if $state{lazy}; } |
231
|
66
|
100
|
|
|
|
205
|
elsif (@scalars) { $type = ref($scalars[0]) ? ECA_DEFAULT_CODE : ECA_DEFAULT; } |
232
|
222
|
|
|
|
|
389
|
else { $type = ECA_REQUIRED; } |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
return ( |
235
|
|
|
|
|
|
|
name => $name, |
236
|
|
|
|
|
|
|
type => $type, |
237
|
|
|
|
|
|
|
value => $scalars[0], |
238
|
|
|
|
|
|
|
check => $state{check}, |
239
|
|
|
|
|
|
|
ro => !!$state{ro}, |
240
|
|
|
|
|
|
|
inject => $state{inject}, |
241
|
|
|
|
|
|
|
method => !$state{no_method}, |
242
|
443
|
|
|
|
|
2862
|
); |
243
|
|
|
|
|
|
|
} |
244
|
|
|
|
|
|
|
|
245
|
1
|
50
|
|
1
|
0
|
7
|
sub info($self) { |
|
1
|
50
|
|
|
|
4
|
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
1
|
|
246
|
1
|
|
|
|
|
4
|
my %info = ( |
247
|
|
|
|
|
|
|
public => { |
248
|
|
|
|
|
|
|
methods => [sort $self->public_methods], |
249
|
|
|
|
|
|
|
attrs => [sort $self->public_attrs], |
250
|
|
|
|
|
|
|
reqs => [sort keys($self->reqs->%*)], |
251
|
|
|
|
|
|
|
}, |
252
|
|
|
|
|
|
|
overridden => [sort keys($self->overridden->%*)], |
253
|
|
|
|
|
|
|
private => [sort keys($self->private->%*)], |
254
|
|
|
|
|
|
|
); |
255
|
1
|
|
|
|
|
16
|
\%info; |
256
|
|
|
|
|
|
|
} |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
1; |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
__END__ |