line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Evo::Attr; |
2
|
67
|
|
|
67
|
|
377
|
use strict; |
|
67
|
|
|
|
|
128
|
|
|
67
|
|
|
|
|
1634
|
|
3
|
67
|
|
|
67
|
|
308
|
use warnings; |
|
67
|
|
|
|
|
137
|
|
|
67
|
|
|
|
|
1550
|
|
4
|
67
|
|
|
67
|
|
339
|
use Carp 'croak'; |
|
67
|
|
|
|
|
111
|
|
|
67
|
|
|
|
|
2370
|
|
5
|
67
|
|
|
67
|
|
21016
|
use Evo::Internal::Util; |
|
67
|
|
|
|
|
170
|
|
|
67
|
|
|
|
|
1832
|
|
6
|
67
|
|
|
67
|
|
372
|
use feature 'signatures'; |
|
67
|
|
|
|
|
126
|
|
|
67
|
|
|
|
|
3501
|
|
7
|
67
|
|
|
67
|
|
345
|
no warnings 'experimental::signatures'; |
|
67
|
|
|
|
|
124
|
|
|
67
|
|
|
|
|
30178
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
my $MCO = \&invoke_handlers; |
10
|
|
|
|
|
|
|
|
11
|
811
|
50
|
|
811
|
0
|
2565
|
sub patch_package ($me, $pkg) { |
|
811
|
50
|
|
|
|
2044
|
|
|
811
|
|
|
|
|
1440
|
|
|
811
|
|
|
|
|
1236
|
|
|
811
|
|
|
|
|
1205
|
|
12
|
811
|
|
|
|
|
3012
|
Evo::Internal::Util::monkey_patch $pkg, MODIFY_CODE_ATTRIBUTES => $MCO; |
13
|
|
|
|
|
|
|
} |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
our %HANDLERS; |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
%HANDLERS = ( |
18
|
|
|
|
|
|
|
Attr => { |
19
|
|
|
|
|
|
|
provider => __PACKAGE__, |
20
|
|
|
|
|
|
|
handler => sub ($provider, $handler, $name) { |
21
|
|
|
|
|
|
|
register_attribute($provider, $name, $handler); |
22
|
|
|
|
|
|
|
} |
23
|
|
|
|
|
|
|
} |
24
|
|
|
|
|
|
|
); |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
# $provider is a key, just for error message |
27
|
189
|
50
|
|
189
|
0
|
2281
|
sub register_attribute ($provider, $name, $handler) { |
|
189
|
50
|
|
|
|
481
|
|
|
189
|
|
|
|
|
331
|
|
|
189
|
|
|
|
|
296
|
|
|
189
|
|
|
|
|
269
|
|
|
189
|
|
|
|
|
285
|
|
28
|
189
|
100
|
|
|
|
667
|
croak "$name was already taken by $HANDLERS{$name}{provider}" if $HANDLERS{$name}; |
29
|
188
|
|
|
|
|
880
|
$HANDLERS{$name} = {provider => $provider, handler => $handler}; |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
|
32
|
1267
|
50
|
|
1267
|
0
|
52039
|
sub invoke_handlers ($dest, $code, @attrs) { |
|
1267
|
|
|
|
|
2204
|
|
|
1267
|
|
|
|
|
1999
|
|
|
1267
|
|
|
|
|
3426
|
|
|
1267
|
|
|
|
|
2021
|
|
33
|
1267
|
|
|
|
|
3682
|
my (undef, $subname) = Evo::Internal::Util::code2names($code); |
34
|
1267
|
|
|
|
|
2353
|
my @remaining; |
35
|
1267
|
|
|
|
|
2539
|
foreach my $attr_raw (@attrs) { |
36
|
1276
|
|
|
|
|
4463
|
my ($attr, @args) = parse_attr($attr_raw); |
37
|
|
|
|
|
|
|
|
38
|
1276
|
100
|
|
|
|
3803
|
if (my $slot = $HANDLERS{$attr}) { |
39
|
1270
|
|
|
|
|
3843
|
$slot->{handler}->($dest, $code, $subname, @args); |
40
|
|
|
|
|
|
|
} |
41
|
6
|
|
|
|
|
18
|
else { push @remaining, $attr_raw } |
42
|
|
|
|
|
|
|
} |
43
|
1267
|
|
|
|
|
3669
|
@remaining; |
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
|
46
|
1280
|
50
|
|
1280
|
0
|
3532
|
sub parse_attr ($attr) { |
|
1280
|
50
|
|
|
|
2778
|
|
|
1280
|
|
|
|
|
2041
|
|
|
1280
|
|
|
|
|
1806
|
|
47
|
1280
|
|
|
|
|
5828
|
$attr =~ /(\w+) ( \( \s* ([\w\,\s]+) \s* \) )?/x; |
48
|
1280
|
|
100
|
|
|
9471
|
return ($1, split /\,\s?/, $3 // ''); |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
1; |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
__END__ |