line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Evo::Export::Meta; |
2
|
56
|
|
|
56
|
|
23908
|
use Evo 'Evo::Internal::Util; Carp croak; Module::Load load'; |
|
56
|
|
|
|
|
134
|
|
|
56
|
|
|
|
|
427
|
|
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
our @CARP_NOT = qw(Evo Evo::Export Evo::Internal::Util); |
5
|
|
|
|
|
|
|
|
6
|
7067
|
50
|
|
7067
|
0
|
15428
|
sub package($self) { $self->{package} } |
|
7067
|
50
|
|
|
|
14575
|
|
|
7067
|
|
|
|
|
10326
|
|
|
7067
|
|
|
|
|
9713
|
|
|
7067
|
|
|
|
|
17743
|
|
7
|
9521
|
50
|
100
|
9521
|
0
|
20831
|
sub symbols($self) { $self->{symbols} //= {} } |
|
9521
|
50
|
|
|
|
19574
|
|
|
9521
|
|
|
|
|
13737
|
|
|
9521
|
|
|
|
|
13057
|
|
|
9521
|
|
|
|
|
40151
|
|
8
|
|
|
|
|
|
|
|
9
|
332
|
50
|
|
332
|
0
|
4375
|
sub new ($me, $pkg, %opts) { |
|
332
|
50
|
|
|
|
1789
|
|
|
332
|
|
|
|
|
651
|
|
|
332
|
|
|
|
|
625
|
|
|
332
|
|
|
|
|
892
|
|
|
332
|
|
|
|
|
576
|
|
10
|
332
|
50
|
|
|
|
912
|
$me = ref($me) if ref $me; |
11
|
332
|
|
|
|
|
2564
|
bless {%opts, package => $pkg}, $me; |
12
|
|
|
|
|
|
|
} |
13
|
|
|
|
|
|
|
|
14
|
3107
|
50
|
|
3107
|
0
|
8148
|
sub find_or_bind_to ($me, $pkg, %opts) { |
|
3107
|
50
|
|
|
|
7829
|
|
|
3107
|
|
|
|
|
5153
|
|
|
3107
|
|
|
|
|
4795
|
|
|
3107
|
|
|
|
|
7833
|
|
|
3107
|
|
|
|
|
5106
|
|
15
|
56
|
|
|
56
|
|
17254
|
no strict 'refs'; ## no critic |
|
56
|
|
|
|
|
241
|
|
|
56
|
|
|
|
|
1913
|
|
16
|
56
|
|
|
56
|
|
1226
|
no warnings 'once'; |
|
56
|
|
|
|
|
787
|
|
|
56
|
|
|
|
|
11281
|
|
17
|
3107
|
|
66
|
|
|
4430
|
${"${pkg}::EVO_EXPORT_META"} ||= $me->new($pkg, %opts); |
|
3107
|
|
|
|
|
18971
|
|
18
|
|
|
|
|
|
|
} |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
# it's important to return same function for the same module |
21
|
|
|
|
|
|
|
# we're storing it in the module, not in slot, to be able to easy destroy a module |
22
|
4198
|
50
|
|
4198
|
0
|
14232
|
sub request ($self, $name, $dpkg) { |
|
4198
|
50
|
|
|
|
8851
|
|
|
4198
|
|
|
|
|
6314
|
|
|
4198
|
|
|
|
|
6336
|
|
|
4198
|
|
|
|
|
6014
|
|
|
4198
|
|
|
|
|
5770
|
|
23
|
4198
|
|
|
|
|
7969
|
my $slot = $self->find_slot($name); |
24
|
4198
|
|
|
|
|
6512
|
my $fn; |
25
|
4198
|
|
|
|
|
7375
|
my $type = $slot->{type}; |
26
|
4198
|
100
|
|
|
|
10331
|
if ($type eq 'code') { |
|
|
50
|
|
|
|
|
|
27
|
2168
|
|
|
|
|
3707
|
$fn = $slot->{code}; |
28
|
|
|
|
|
|
|
} |
29
|
|
|
|
|
|
|
elsif ($type eq 'gen') { |
30
|
56
|
|
|
56
|
|
428
|
no warnings 'once'; |
|
56
|
|
|
|
|
1809
|
|
|
56
|
|
|
|
|
1730
|
|
31
|
56
|
|
|
56
|
|
305
|
no strict 'refs'; ## no critic |
|
56
|
|
|
|
|
123
|
|
|
56
|
|
|
|
|
29930
|
|
32
|
2030
|
|
|
|
|
4231
|
my $pkg = $self->package; |
33
|
2030
|
|
100
|
|
|
3500
|
my $cache = ${"${dpkg}::EVO_EXPORT_CACHE"} ||= {}; |
|
2030
|
|
|
|
|
9181
|
|
34
|
2030
|
100
|
|
|
|
5465
|
return $cache->{$pkg}{$name} if $cache->{$pkg}{$name}; |
35
|
2004
|
|
|
|
|
3965
|
return $cache->{$pkg}{$name} = $slot->{gen}->($self->package, $dpkg); |
36
|
|
|
|
|
|
|
} |
37
|
|
|
|
|
|
|
|
38
|
2168
|
50
|
|
|
|
4577
|
croak "Something wrong" unless $fn; |
39
|
2168
|
|
|
|
|
3941
|
return $fn; |
40
|
|
|
|
|
|
|
} |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
# traverse to find gen via links, return Module, name, gen |
43
|
4730
|
50
|
|
4730
|
0
|
10152
|
sub find_slot ($self, $name) { |
|
4730
|
50
|
|
|
|
9916
|
|
|
4730
|
|
|
|
|
6854
|
|
|
4730
|
|
|
|
|
7554
|
|
|
4730
|
|
|
|
|
6443
|
|
44
|
4730
|
100
|
|
|
|
8625
|
croak qq{"${\$self->package}" doesn't export "$name"} unless my $slot = $self->symbols->{$name}; |
|
2
|
|
|
|
|
5
|
|
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
|
47
|
1998
|
50
|
|
1998
|
0
|
4798
|
sub init_slot ($self, $name, $val) { |
|
1998
|
50
|
|
|
|
4525
|
|
|
1998
|
|
|
|
|
3163
|
|
|
1998
|
|
|
|
|
3054
|
|
|
1998
|
|
|
|
|
3106
|
|
|
1998
|
|
|
|
|
2873
|
|
48
|
1998
|
|
|
|
|
4090
|
my $pkg = $self->package; |
49
|
1998
|
100
|
|
|
|
4653
|
croak "$pkg already exports $name" if $self->symbols->{$name}; |
50
|
1997
|
|
|
|
|
4310
|
$self->symbols->{$name} = $val; |
51
|
|
|
|
|
|
|
} |
52
|
|
|
|
|
|
|
|
53
|
530
|
50
|
|
530
|
0
|
1283
|
sub export_from ($self, $name, $origpkg, $origname) { |
|
530
|
50
|
|
|
|
1338
|
|
|
530
|
|
|
|
|
1044
|
|
|
530
|
|
|
|
|
857
|
|
|
530
|
|
|
|
|
836
|
|
|
530
|
|
|
|
|
818
|
|
|
530
|
|
|
|
|
762
|
|
54
|
530
|
|
|
|
|
1076
|
my $slot = $self->find_or_bind_to($origpkg)->find_slot($origname); |
55
|
529
|
|
|
|
|
1251
|
$self->init_slot($name, $slot); |
56
|
|
|
|
|
|
|
} |
57
|
|
|
|
|
|
|
|
58
|
544
|
50
|
|
544
|
0
|
1545
|
sub export_gen ($self, $name, $gen) { |
|
544
|
50
|
|
|
|
1397
|
|
|
544
|
|
|
|
|
895
|
|
|
544
|
|
|
|
|
855
|
|
|
544
|
|
|
|
|
842
|
|
|
544
|
|
|
|
|
831
|
|
59
|
544
|
|
|
|
|
2253
|
$self->init_slot($name, {gen => $gen, type => 'gen'}); |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
|
62
|
923
|
50
|
|
923
|
0
|
2821
|
sub export_code ($self, $name, $sub) { |
|
923
|
50
|
|
|
|
2162
|
|
|
923
|
|
|
|
|
1523
|
|
|
923
|
|
|
|
|
1496
|
|
|
923
|
|
|
|
|
1406
|
|
|
923
|
|
|
|
|
1385
|
|
63
|
923
|
|
|
|
|
3739
|
$self->init_slot($name, {type => 'code', code => $sub}); |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
|
66
|
338
|
50
|
|
338
|
0
|
1011
|
sub export ($self, $name_as) { |
|
338
|
50
|
|
|
|
1260
|
|
|
338
|
|
|
|
|
786
|
|
|
338
|
|
|
|
|
642
|
|
|
338
|
|
|
|
|
528
|
|
67
|
338
|
|
|
|
|
817
|
my $pkg = $self->package; |
68
|
338
|
|
|
|
|
1299
|
my ($name, $as) = split ':', $name_as; |
69
|
338
|
|
66
|
|
|
1811
|
$as ||= $name; |
70
|
338
|
|
|
|
|
817
|
my $full = "${pkg}::$name"; |
71
|
56
|
|
|
56
|
|
408
|
no strict 'refs'; ## no critic |
|
56
|
|
|
|
|
1199
|
|
|
56
|
|
|
|
|
36367
|
|
72
|
338
|
100
|
|
|
|
568
|
my $sub = *{$full}{CODE} or croak "Subroutine $full doesn't exists"; |
|
338
|
|
|
|
|
5326
|
|
73
|
336
|
|
|
|
|
1265
|
$self->export_code($as, $sub); |
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
|
77
|
100
|
50
|
|
100
|
0
|
408
|
sub export_proxy ($self, $origpkg, @xlist) { |
|
100
|
|
|
|
|
284
|
|
|
100
|
|
|
|
|
212
|
|
|
100
|
|
|
|
|
389
|
|
|
100
|
|
|
|
|
225
|
|
78
|
100
|
|
|
|
|
321
|
$origpkg = Evo::Internal::Util::resolve_package($self->package, $origpkg); |
79
|
100
|
|
|
|
|
514
|
load $origpkg; |
80
|
100
|
|
|
|
|
7657
|
my @list = $self->find_or_bind_to($origpkg)->expand_wildcards(@xlist); |
81
|
|
|
|
|
|
|
|
82
|
100
|
|
|
|
|
380
|
foreach my $name_as (@list) { |
83
|
528
|
|
|
|
|
1553
|
my ($origname, $name) = split ':', $name_as; |
84
|
528
|
|
66
|
|
|
2382
|
$name ||= $origname; |
85
|
528
|
|
|
|
|
1268
|
$self->export_from($name, $origpkg, $origname); |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
|
90
|
696
|
50
|
|
696
|
0
|
1885
|
sub expand_wildcards ($self, @list) { |
|
696
|
|
|
|
|
1233
|
|
|
696
|
|
|
|
|
1776
|
|
|
696
|
|
|
|
|
1266
|
|
91
|
696
|
|
|
|
|
1778
|
my %symbols = $self->symbols->%*; |
92
|
696
|
|
|
|
|
1820
|
my (%minus, %res); |
93
|
696
|
|
|
|
|
1678
|
foreach my $cur (@list) { |
94
|
959
|
100
|
|
|
|
2859
|
if ($cur eq '*') { |
|
|
100
|
|
|
|
|
|
95
|
558
|
100
|
|
|
|
1454
|
croak "${\$self->package} exports nothing" unless %symbols; |
|
1
|
|
|
|
|
3
|
|
96
|
557
|
|
|
|
|
3627
|
$res{$_}++ for keys %symbols; |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
elsif ($cur =~ /^-(.+)/) { |
99
|
43
|
|
|
|
|
157
|
$minus{$1}++; |
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
else { |
102
|
358
|
|
|
|
|
891
|
$res{$cur}++; |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
} |
105
|
695
|
|
|
|
|
2067
|
return (sort grep { !$minus{$_} } keys %res); |
|
4751
|
|
|
|
|
13748
|
|
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
594
|
50
|
|
594
|
0
|
1889
|
sub install ($self, $dst, @xlist) { |
|
594
|
|
|
|
|
1129
|
|
|
594
|
|
|
|
|
1036
|
|
|
594
|
|
|
|
|
1684
|
|
|
594
|
|
|
|
|
1033
|
|
109
|
594
|
|
|
|
|
1657
|
my @list = $self->expand_wildcards(@xlist); |
110
|
|
|
|
|
|
|
|
111
|
594
|
|
|
|
|
2413
|
my $liststr = join '; ', @list; |
112
|
594
|
|
|
|
|
1736
|
my $exporter = $self->package; |
113
|
|
|
|
|
|
|
|
114
|
594
|
|
|
|
|
1097
|
my %patch; |
115
|
594
|
|
|
|
|
1235
|
foreach my $name_as (@list) { |
116
|
4179
|
|
|
|
|
11278
|
my ($name, $as) = split ':', $name_as; |
117
|
4179
|
|
66
|
|
|
18108
|
$as ||= $name; |
118
|
4179
|
|
|
|
|
8821
|
my $fn = $self->request($name, $dst); |
119
|
4179
|
|
|
|
|
10178
|
$patch{$as} = $fn; |
120
|
|
|
|
|
|
|
} |
121
|
594
|
|
|
|
|
2967
|
Evo::Internal::Util::monkey_patch $dst, %patch; |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
|
124
|
56
|
|
|
56
|
|
459
|
no warnings 'once'; |
|
56
|
|
|
|
|
201
|
|
|
56
|
|
|
|
|
2820
|
|
125
|
|
|
|
|
|
|
*info = *symbols; |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
1; |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
__END__ |