line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
package Jojo::Role::Compat; |
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
our $VERSION = '0.5.0'; |
5
|
|
|
|
|
|
|
|
6
|
1
|
|
|
1
|
|
646
|
use 5.018; |
|
1
|
|
|
|
|
3
|
|
7
|
1
|
|
|
1
|
|
5
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
19
|
|
8
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
21
|
|
9
|
1
|
|
|
1
|
|
612
|
use utf8; |
|
1
|
|
|
|
|
14
|
|
|
1
|
|
|
|
|
5
|
|
10
|
1
|
|
|
1
|
|
31
|
use feature (); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
13
|
|
11
|
1
|
|
|
1
|
|
499
|
use experimental (); |
|
1
|
|
|
|
|
3322
|
|
|
1
|
|
|
|
|
73
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
BEGIN { |
14
|
1
|
|
|
1
|
|
582
|
require Role::Tiny; |
15
|
1
|
|
|
|
|
4408
|
Role::Tiny->VERSION('2.000006'); |
16
|
1
|
|
|
|
|
44
|
our @ISA = qw(Role::Tiny); |
17
|
|
|
|
|
|
|
} |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
#use Sub::Inject 0.3.0 (); |
20
|
1
|
|
|
1
|
|
453
|
use Importer::Zim (); |
|
1
|
|
|
|
|
4622
|
|
|
1
|
|
|
|
|
78
|
|
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
# Aliasing of Role::Tiny symbols |
23
|
|
|
|
|
|
|
BEGIN { |
24
|
1
|
|
|
1
|
|
4
|
*INFO = \%Role::Tiny::INFO; |
25
|
1
|
|
|
|
|
3
|
*APPLIED_TO = \%Role::Tiny::APPLIED_TO; |
26
|
1
|
|
|
|
|
2
|
*COMPOSED = \%Role::Tiny::COMPOSED; |
27
|
1
|
|
|
|
|
2
|
*COMPOSITE_INFO = \%Role::Tiny::COMPOSITE_INFO; |
28
|
1
|
|
|
|
|
3
|
*ON_ROLE_CREATE = \@Role::Tiny::ON_ROLE_CREATE; |
29
|
|
|
|
|
|
|
|
30
|
1
|
|
|
|
|
821
|
*_getstash = \&Role::Tiny::_getstash; |
31
|
|
|
|
|
|
|
} |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
our %INFO; |
34
|
|
|
|
|
|
|
our %APPLIED_TO; |
35
|
|
|
|
|
|
|
our %COMPOSED; |
36
|
|
|
|
|
|
|
our %COMPOSITE_INFO; |
37
|
|
|
|
|
|
|
our @ON_ROLE_CREATE; |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
our %EXPORT_TAGS; |
40
|
|
|
|
|
|
|
our %EXPORT_GEN; |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
# Jojo::Role->apply_roles_to_package('Some::Package', qw(Some::Role +Other::Role)); |
44
|
|
|
|
|
|
|
sub apply_roles_to_package { |
45
|
0
|
|
|
0
|
1
|
|
my ($self, $target) = (shift, shift); |
46
|
|
|
|
|
|
|
return $self->Role::Tiny::apply_roles_to_package($target, |
47
|
0
|
0
|
|
|
|
|
map { /^\+(.+)$/ ? "${target}::Role::$1" : $_ } @_); |
|
0
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
# Jojo::Role->create_class_with_roles('Some::Base', qw(Some::Role1 +Role2)); |
51
|
|
|
|
|
|
|
sub create_class_with_roles { |
52
|
0
|
|
|
0
|
1
|
|
my ($self, $target) = (shift, shift); |
53
|
|
|
|
|
|
|
return $self->Role::Tiny::create_class_with_roles($target, |
54
|
0
|
0
|
|
|
|
|
map { /^\+(.+)$/ ? "${target}::Role::$1" : $_ } @_); |
|
0
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
sub import { |
58
|
0
|
|
|
0
|
|
|
my $target = caller; |
59
|
0
|
|
|
|
|
|
my $me = shift; |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
# Jojo modules are strict! |
62
|
0
|
|
|
|
|
|
$_->import for qw(strict warnings utf8); |
63
|
0
|
|
|
|
|
|
feature->import(':5.18'); |
64
|
0
|
|
|
|
|
|
experimental->import('lexical_subs'); |
65
|
|
|
|
|
|
|
|
66
|
0
|
|
|
|
|
|
my $flag = shift; |
67
|
0
|
0
|
|
|
|
|
if (!$flag) { |
68
|
0
|
|
|
|
|
|
$me->make_role($target); |
69
|
0
|
|
|
|
|
|
$flag = '-role'; |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
|
72
|
0
|
|
0
|
|
|
|
my @exports = @{$EXPORT_TAGS{$flag} // []}; |
|
0
|
|
|
|
|
|
|
73
|
0
|
|
|
|
|
|
my %exports = $me->_generate_subs($target, @exports); |
74
|
0
|
|
|
|
|
|
Importer::Zim::export_to($target, %exports); |
75
|
|
|
|
|
|
|
#goto &Sub::Inject::sub_inject; |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
|
78
|
0
|
|
|
0
|
0
|
|
sub role_provider { $_[0] } |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
sub make_role { |
81
|
0
|
|
|
0
|
0
|
|
my ($me, $target) = @_; |
82
|
0
|
0
|
|
|
|
|
return if $me->is_role($target); # already exported into this package |
83
|
0
|
|
|
|
|
|
$INFO{$target}{is_role} = 1; |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
# get symbol table reference |
86
|
0
|
|
|
|
|
|
my $stash = _getstash($target); |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
# grab all *non-constant* (stash slot is not a scalarref) subs present |
89
|
|
|
|
|
|
|
# in the symbol table and store their refaddrs (no need to forcibly |
90
|
|
|
|
|
|
|
# inflate constant subs into real subs) with a map to the coderefs in |
91
|
|
|
|
|
|
|
# case of copying or re-use |
92
|
|
|
|
|
|
|
my @not_methods |
93
|
0
|
0
|
0
|
|
|
|
= map +(ref $_ eq 'CODE' ? $_ : ref $_ ? () : *$_{CODE} || ()), |
|
|
0
|
|
|
|
|
|
94
|
|
|
|
|
|
|
values %$stash; |
95
|
0
|
|
|
|
|
|
@{$INFO{$target}{not_methods} = {}}{@not_methods} = @not_methods; |
|
0
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
# a role does itself |
98
|
0
|
|
|
|
|
|
$APPLIED_TO{$target} = {$target => undef}; |
99
|
0
|
|
|
|
|
|
foreach my $hook (@ON_ROLE_CREATE) { |
100
|
0
|
|
|
|
|
|
$hook->($target); |
101
|
|
|
|
|
|
|
} |
102
|
0
|
|
|
|
|
|
return; |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
BEGIN { |
106
|
1
|
|
|
1
|
|
8
|
%EXPORT_TAGS = ( # |
107
|
|
|
|
|
|
|
-role => [qw(after around before requires with)], |
108
|
|
|
|
|
|
|
-with => [qw(with)], |
109
|
|
|
|
|
|
|
); |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
%EXPORT_GEN = ( |
112
|
|
|
|
|
|
|
requires => sub { |
113
|
0
|
|
|
|
|
0
|
my (undef, $target) = @_; |
114
|
|
|
|
|
|
|
return sub { |
115
|
0
|
|
0
|
|
|
0
|
push @{$INFO{$target}{requires} ||= []}, @_; |
|
0
|
|
|
|
|
0
|
|
116
|
0
|
|
|
|
|
0
|
return; |
117
|
0
|
|
|
|
|
0
|
}; |
118
|
|
|
|
|
|
|
}, |
119
|
|
|
|
|
|
|
with => sub { |
120
|
0
|
|
|
|
|
0
|
my ($me, $target) = (shift->role_provider, shift); |
121
|
|
|
|
|
|
|
return sub { |
122
|
0
|
|
|
|
|
0
|
$me->apply_roles_to_package($target, @_); |
123
|
0
|
|
|
|
|
0
|
return; |
124
|
0
|
|
|
|
|
0
|
}; |
125
|
|
|
|
|
|
|
}, |
126
|
1
|
|
|
|
|
7
|
); |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
# before/after/around |
129
|
1
|
|
|
|
|
3
|
foreach my $type (qw(before after around)) { |
130
|
|
|
|
|
|
|
$EXPORT_GEN{$type} = sub { |
131
|
0
|
|
|
|
|
|
my (undef, $target) = @_; |
132
|
|
|
|
|
|
|
return sub { |
133
|
0
|
|
0
|
|
|
|
push @{$INFO{$target}{modifiers} ||= []}, [$type => @_]; |
|
0
|
|
|
|
|
|
|
134
|
0
|
|
|
|
|
|
return; |
135
|
0
|
|
|
|
|
|
}; |
136
|
3
|
|
|
|
|
120
|
}; |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
sub _generate_subs { |
141
|
0
|
|
|
0
|
|
|
my ($class, $target) = (shift, shift); |
142
|
0
|
|
|
|
|
|
return map { my $cb = $EXPORT_GEN{$_}; $_ => $class->$cb($target) } @_; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
} |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
1; |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
__END__ |