line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
package Role::NotSoTiny; |
3
|
|
|
|
|
|
|
$Role::NotSoTiny::VERSION = '0.1.0'; # TRIAL |
4
|
18
|
|
|
18
|
|
931957
|
use strict; |
|
18
|
|
|
|
|
144
|
|
|
18
|
|
|
|
|
399
|
|
5
|
18
|
|
|
18
|
|
70
|
use warnings; |
|
18
|
|
|
|
|
27
|
|
|
18
|
|
|
|
|
788
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
BEGIN { |
8
|
18
|
|
|
18
|
|
8205
|
require Role::Tiny; |
9
|
18
|
|
|
|
|
59611
|
Role::Tiny->VERSION('2.000005'); |
10
|
18
|
|
|
|
|
1342
|
our @ISA = qw(Role::Tiny); |
11
|
|
|
|
|
|
|
} |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
# Aliasing of Role::Tiny symbols |
14
|
|
|
|
|
|
|
BEGIN { |
15
|
18
|
|
|
18
|
|
68
|
*INFO = \%Role::Tiny::INFO; |
16
|
18
|
|
|
|
|
36
|
*APPLIED_TO = \%Role::Tiny::APPLIED_TO; |
17
|
18
|
|
|
|
|
39
|
*ON_ROLE_CREATE = \@Role::Tiny::ON_ROLE_CREATE; |
18
|
|
|
|
|
|
|
|
19
|
18
|
|
|
|
|
44
|
*_getstash = \&Role::Tiny::_getstash; |
20
|
18
|
|
|
0
|
|
3568
|
*_getglob = \&Role::Tiny::_getglob; |
21
|
|
|
|
|
|
|
} |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
our %INFO; |
24
|
|
|
|
|
|
|
our %APPLIED_TO; |
25
|
|
|
|
|
|
|
our @ON_ROLE_CREATE; |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
sub import { |
28
|
58
|
|
|
58
|
|
6994
|
my $target = caller; |
29
|
58
|
|
|
|
|
80
|
my $me = shift; |
30
|
58
|
|
|
|
|
235
|
strict->import; |
31
|
58
|
|
|
|
|
499
|
warnings->import; |
32
|
58
|
|
|
|
|
230
|
$me->_install_subs($target); |
33
|
58
|
|
|
|
|
2849
|
$me->make_role($target); |
34
|
|
|
|
|
|
|
} |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
sub make_role { |
37
|
60
|
|
|
60
|
1
|
165
|
my ( $me, $target ) = @_; |
38
|
60
|
50
|
|
|
|
122
|
return if $me->is_role($target); # already exported into this package |
39
|
60
|
|
|
|
|
388
|
$INFO{$target}{is_role} = 1; |
40
|
|
|
|
|
|
|
# get symbol table reference |
41
|
60
|
|
|
|
|
109
|
my $stash = _getstash($target); |
42
|
|
|
|
|
|
|
# grab all *non-constant* (stash slot is not a scalarref) subs present |
43
|
|
|
|
|
|
|
# in the symbol table and store their refaddrs (no need to forcibly |
44
|
|
|
|
|
|
|
# inflate constant subs into real subs) with a map to the coderefs in |
45
|
|
|
|
|
|
|
# case of copying or re-use |
46
|
|
|
|
|
|
|
my @not_methods |
47
|
60
|
50
|
66
|
|
|
873
|
= map +( ref $_ eq 'CODE' ? $_ : ref $_ ? () : *$_{CODE} || () ), |
|
|
50
|
|
|
|
|
|
48
|
|
|
|
|
|
|
values %$stash; |
49
|
60
|
|
|
|
|
109
|
@{ $INFO{$target}{not_methods} = {} }{@not_methods} = @not_methods; |
|
60
|
|
|
|
|
317
|
|
50
|
|
|
|
|
|
|
# a role does itself |
51
|
60
|
|
|
|
|
149
|
$APPLIED_TO{$target} = { $target => undef }; |
52
|
60
|
|
|
|
|
10198
|
foreach my $hook (@ON_ROLE_CREATE) { |
53
|
2
|
|
|
|
|
5
|
$hook->($target); |
54
|
|
|
|
|
|
|
} |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
1; |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
#pod =encoding utf8 |
60
|
|
|
|
|
|
|
#pod |
61
|
|
|
|
|
|
|
#pod =head1 NAME |
62
|
|
|
|
|
|
|
#pod |
63
|
|
|
|
|
|
|
#pod Role::NotSoTiny - Experiment with Role::Tiny / Role::NotSoTiny->make_role() |
64
|
|
|
|
|
|
|
#pod |
65
|
|
|
|
|
|
|
#pod =head1 SYNOPSIS |
66
|
|
|
|
|
|
|
#pod |
67
|
|
|
|
|
|
|
#pod use Role::NotSoTiny (); |
68
|
|
|
|
|
|
|
#pod |
69
|
|
|
|
|
|
|
#pod Role::NotSoTiny->make_role('Foo'); |
70
|
|
|
|
|
|
|
#pod *Foo::foo = sub {...}; |
71
|
|
|
|
|
|
|
#pod |
72
|
|
|
|
|
|
|
#pod # runtime equivalent of |
73
|
|
|
|
|
|
|
#pod package Foo; |
74
|
|
|
|
|
|
|
#pod use Role::Tiny; |
75
|
|
|
|
|
|
|
#pod sub foo {...} |
76
|
|
|
|
|
|
|
#pod |
77
|
|
|
|
|
|
|
#pod =head1 DESCRIPTION |
78
|
|
|
|
|
|
|
#pod |
79
|
|
|
|
|
|
|
#pod This module is an experiment with L. |
80
|
|
|
|
|
|
|
#pod The change here is being a proposed as a patch to the original code. |
81
|
|
|
|
|
|
|
#pod See L. |
82
|
|
|
|
|
|
|
#pod |
83
|
|
|
|
|
|
|
#pod =head1 METHODS |
84
|
|
|
|
|
|
|
#pod |
85
|
|
|
|
|
|
|
#pod L inherits all methods of L and |
86
|
|
|
|
|
|
|
#pod implements the following new ones. |
87
|
|
|
|
|
|
|
#pod |
88
|
|
|
|
|
|
|
#pod =head2 make_role |
89
|
|
|
|
|
|
|
#pod |
90
|
|
|
|
|
|
|
#pod Role::NotSoTiny->make_role('Some::Package'); |
91
|
|
|
|
|
|
|
#pod |
92
|
|
|
|
|
|
|
#pod Promotes a given package to a role. |
93
|
|
|
|
|
|
|
#pod No subroutines are imported into C<'Some::Package'>. |
94
|
|
|
|
|
|
|
#pod |
95
|
|
|
|
|
|
|
#pod =cut |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
__END__ |