Profile of Class/Method/Modifiers.pm

Filename	/usr/share/perl5/Class/Method/Modifiers.pm
Statements	Executed 170 statements in 2.01ms

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
4	1	1	427µs	688µs	Class::Method::Modifiers::install_modifier
6	2	1	255µs	255µs	Class::Method::Modifiers::::_sub_attrsClass::Method::Modifiers::_sub_attrs
1	1	1	13µs	26µs	Class::Method::Modifiers::::BEGIN@200Class::Method::Modifiers::BEGIN@200
1	1	1	12µs	19µs	Class::Method::Modifiers::::BEGIN@151Class::Method::Modifiers::BEGIN@151
1	1	1	12µs	23µs	Class::Method::Modifiers::::BEGIN@204Class::Method::Modifiers::BEGIN@204
1	1	1	9µs	19µs	Class::Method::Modifiers::::BEGIN@150Class::Method::Modifiers::BEGIN@150
1	1	1	9µs	14µs	Class::Method::Modifiers::::BEGIN@11Class::Method::Modifiers::BEGIN@11
1	1	1	9µs	9µs	Class::Method::Modifiers::::BEGIN@7Class::Method::Modifiers::BEGIN@7
1	1	1	9µs	22µs	Class::Method::Modifiers::::BEGIN@58Class::Method::Modifiers::BEGIN@58
1	1	1	8µs	86µs	Class::Method::Modifiers::::BEGIN@14Class::Method::Modifiers::BEGIN@14
1	1	1	8µs	20µs	Class::Method::Modifiers::::BEGIN@149Class::Method::Modifiers::BEGIN@149
1	1	1	8µs	21µs	Class::Method::Modifiers::::BEGIN@10Class::Method::Modifiers::BEGIN@10
1	1	1	6µs	6µs	Class::Method::Modifiers::::BEGIN@23Class::Method::Modifiers::BEGIN@23
0	0	0	0s	0s	Class::Method::Modifiers::::_freshClass::Method::Modifiers::_fresh
0	0	0	0s	0s	Class::Method::Modifiers::_is_in_package
0	0	0	0s	0s	Class::Method::Modifiers::::afterClass::Method::Modifiers::after
0	0	0	0s	0s	Class::Method::Modifiers::::aroundClass::Method::Modifiers::around
0	0	0	0s	0s	Class::Method::Modifiers::::beforeClass::Method::Modifiers::before
0	0	0	0s	0s	Class::Method::Modifiers::::freshClass::Method::Modifiers::fresh

Call graph for these subroutines as a Graphviz dot language file.

Line	State ments	Time on line	Calls	Time in subs	Code
1					package Class::Method::Modifiers;
2					{
3	2	1µs			$Class::Method::Modifiers::VERSION = '2.09';
4					}
5					# git description: v2.08-4-g82f0517
6
7					# spent 9µs within Class::Method::Modifiers::BEGIN@7 which was called: # once (9µs+0s) by Moo::Role::before at line 9 BEGIN {
8	1	6µs			$Class::Method::Modifiers::AUTHORITY = 'cpan:SARTAK';
9	1	25µs	1	9µs	} # spent 9µs making 1 call to Class::Method::Modifiers::BEGIN@7
10	2	27µs	2	34µs	# spent 21µs (8+13) within Class::Method::Modifiers::BEGIN@10 which was called: # once (8µs+13µs) by Moo::Role::before at line 10 use strict; # spent 21µs making 1 call to Class::Method::Modifiers::BEGIN@10 # spent 13µs making 1 call to strict::import
11	2	33µs	2	18µs	# spent 14µs (9+5) within Class::Method::Modifiers::BEGIN@11 which was called: # once (9µs+5µs) by Moo::Role::before at line 11 use warnings; # spent 14µs making 1 call to Class::Method::Modifiers::BEGIN@11 # spent 5µs making 1 call to warnings::import
12
13					# work around https://rt.cpan.org/Ticket/Display.html?id=89173
14	2	118µs	2	163µs	# spent 86µs (8+77) within Class::Method::Modifiers::BEGIN@14 which was called: # once (8µs+77µs) by Moo::Role::before at line 14 use base ('Exp'.'orter'); # spent 86µs making 1 call to Class::Method::Modifiers::BEGIN@14 # spent 77µs making 1 call to base::import
15
16	1	1µs			our @EXPORT = qw(before after around);
17	1	1µs			our @EXPORT_OK = (@EXPORT, qw(fresh install_modifier));
18	1	3µs			our %EXPORT_TAGS = (
19					moose => [qw(before after around)],
20					all => \@EXPORT_OK,
21					);
22
23					# spent 6µs within Class::Method::Modifiers::BEGIN@23 which was called: # once (6µs+0s) by Moo::Role::before at line 25 BEGIN {
24	1	10µs			*_HAS_READONLY = $] >= 5.008 ? sub(){1} : sub(){0};
25	1	197µs	1	6µs	} # spent 6µs making 1 call to Class::Method::Modifiers::BEGIN@23
26
27	1	100ns			our %MODIFIER_CACHE;
28
29					# for backward compatibility
30					sub _install_modifier; # -w
31	1	2µs			*_install_modifier = \&install_modifier;
32
33					# spent 688µs (427+261) within Class::Method::Modifiers::install_modifier which was called 4 times, avg 172µs/call: # 4 times (427µs+261µs) by Moo::_Utils::_install_modifier at line 36 of Moo/_Utils.pm, avg 172µs/call sub install_modifier {
34	4	2µs			my $into = shift;
35	4	900ns			my $type = shift;
36	4	1µs			my $code = pop;
37	4	3µs			my @names = @_;
38
39	4	2µs			@names = @{ $names[0] } if ref($names[0]) eq 'ARRAY';
40
41	4	900ns			return _fresh($into, $code, @names) if $type eq 'fresh';
42
43	4	19µs			for my $name (@names) {
44	4	17µs	4	6µs	my $hit = $into->can($name) or do { # spent 6µs making 4 calls to UNIVERSAL::can, avg 2µs/call
45					require Carp;
46					Carp::confess("The method '$name' is not found in the inheritance hierarchy for class $into");
47					};
48
49	4	3µs			my $qualified = $into.'::'.$name;
50	4	10µs			my $cache = $MODIFIER_CACHE{$into}{$name} \|\|= {
51					before => [],
52					after => [],
53					around => [],
54					};
55
56					# this must be the first modifier we're installing
57	4	2µs			if (!exists($cache->{"orig"})) {
58	2	266µs	2	34µs	# spent 22µs (9+13) within Class::Method::Modifiers::BEGIN@58 which was called: # once (9µs+13µs) by Moo::Role::before at line 58 no strict 'refs'; # spent 22µs making 1 call to Class::Method::Modifiers::BEGIN@58 # spent 13µs making 1 call to strict::unimport
59
60					# grab the original method (or undef if the method is inherited)
61	4	6µs			$cache->{"orig"} = *{$qualified}{CODE};
62
63					# the "innermost" method, the one that "around" will ultimately wrap
64	4	2µs			$cache->{"wrapped"} = $cache->{"orig"} \|\| $hit; #sub {
65					# # we can't cache this, because new methods or modifiers may be
66					# # added between now and when this method is called
67					# for my $package (@{ mro::get_linear_isa($into) }) {
68					# next if $package eq $into;
69					# my $code = *{$package.'::'.$name}{CODE};
70					# goto $code if $code;
71					# }
72					# require Carp;
73					# Carp::confess("$qualified\::$name disappeared?");
74					#};
75					}
76
77					# keep these lists in the order the modifiers are called
78	4	1µs			if ($type eq 'after') {
79					push @{ $cache->{$type} }, $code;
80					}
81					else {
82	4	3µs			unshift @{ $cache->{$type} }, $code;
83					}
84
85					# wrap the method with another layer of around. much simpler than
86					# the Moose equivalent. :)
87	4	2µs			if ($type eq 'around') {
88	2	500ns			my $method = $cache->{wrapped};
89	2	7µs	2	90µs	my $attrs = _sub_attrs($code); # spent 90µs making 2 calls to Class::Method::Modifiers::_sub_attrs, avg 45µs/call
90					# a bare "sub :lvalue {...}" will be parsed as a label and an
91					# indirect method call. force it to be treated as an expression
92					# using +
93	2	88µs			$cache->{wrapped} = eval "package $into; +sub $attrs { \$code->(\$method, \@_); };"; # spent 21µs executing statements in string eval # includes 18µs spent executing 2 calls to 1 sub defined therein. # spent 8µs executing statements in string eval # includes 5µs spent executing 1 call to 1 sub defined therein.
94					}
95
96					# install our new method which dispatches the modifiers, but only
97					# if a new type was added
98	4	9µs			if (@{ $cache->{$type} } == 1) {
99
100					# avoid these hash lookups every method invocation
101	4	1µs			my $before = $cache->{"before"};
102	4	900ns			my $after = $cache->{"after"};
103
104					# this is a coderef that changes every new "around". so we need
105					# to take a reference to it. better a deref than a hash lookup
106	4	1µs			my $wrapped = \$cache->{"wrapped"};
107
108	4	16µs	4	165µs	my $attrs = _sub_attrs($cache->{wrapped}); # spent 165µs making 4 calls to Class::Method::Modifiers::_sub_attrs, avg 41µs/call
109
110	4	4µs			my $generated = "package $into;\n";
111	4	3µs			$generated .= "sub $name $attrs {";
112
113					# before is easy, it doesn't affect the return value(s)
114	4	2µs			if (@$before) {
115					$generated .= '
116					for my $method (@$before) {
117					$method->(@_);
118					}
119					';
120					}
121
122	4	1µs			if (@$after) {
123					$generated .= '
124					my $ret;
125					if (wantarray) {
126					$ret = [$$wrapped->(@_)];
127					'.(_HAS_READONLY ? 'Internals::SvREADONLY(@$ret, 1);' : '').'
128					}
129					elsif (defined wantarray) {
130					$ret = \($$wrapped->(@_));
131					}
132					else {
133					$$wrapped->(@_);
134					}
135
136					for my $method (@$after) {
137					$method->(@_);
138					}
139
140					wantarray ? @$ret : $ret ? $$ret : ();
141					'
142					}
143					else {
144	4	1µs			$generated .= '$$wrapped->(@_);';
145					}
146
147	4	500ns			$generated .= '}';
148
149	2	30µs	2	32µs	# spent 20µs (8+12) within Class::Method::Modifiers::BEGIN@149 which was called: # once (8µs+12µs) by Moo::Role::before at line 149 no strict 'refs'; # spent 20µs making 1 call to Class::Method::Modifiers::BEGIN@149 # spent 12µs making 1 call to strict::unimport
150	2	30µs	2	30µs	# spent 19µs (9+11) within Class::Method::Modifiers::BEGIN@150 which was called: # once (9µs+11µs) by Moo::Role::before at line 150 no warnings 'redefine'; # spent 19µs making 1 call to Class::Method::Modifiers::BEGIN@150 # spent 11µs making 1 call to warnings::unimport
151	2	323µs	2	26µs	# spent 19µs (12+7) within Class::Method::Modifiers::BEGIN@151 which was called: # once (12µs+7µs) by Moo::Role::before at line 151 no warnings 'closure'; # spent 19µs making 1 call to Class::Method::Modifiers::BEGIN@151 # spent 7µs making 1 call to warnings::unimport
152	4	205µs			eval $generated; # spent 21µs executing statements in string eval # includes 104µs spent executing 4 calls to 1 sub defined therein. # spent 18µs executing statements in string eval # includes 29µs spent executing 2 calls to 1 sub defined therein. # spent 12µs executing statements in string eval # includes 16µs spent executing 2 calls to 1 sub defined therein. # spent 4µs executing statements in string eval # includes 4µs spent executing 1 call to 1 sub defined therein.
153					};
154					}
155					}
156
157					sub before {
158					_install_modifier(scalar(caller), 'before', @_);
159					}
160
161					sub after {
162					_install_modifier(scalar(caller), 'after', @_);
163					}
164
165					sub around {
166					_install_modifier(scalar(caller), 'around', @_);
167					}
168
169					sub fresh {
170					my $code = pop;
171					my @names = @_;
172
173					@names = @{ $names[0] } if ref($names[0]) eq 'ARRAY';
174
175					_fresh(scalar(caller), $code, @names);
176					}
177
178					sub _fresh {
179					my ($into, $code, @names) = @_;
180
181					for my $name (@names) {
182					if ($name !~ /\A [a-zA-Z_] [a-zA-Z0-9_]* \z/xms) {
183					require Carp;
184					Carp::confess("Invalid method name '$name'");
185					}
186					if ($into->can($name)) {
187					require Carp;
188					Carp::confess("Class $into already has a method named '$name'");
189					}
190
191					# We need to make sure that the installed method has its CvNAME in
192					# the appropriate package; otherwise, it would be subject to
193					# deletion if callers use namespace::autoclean. If $code was
194					# compiled in the target package, we can just install it directly;
195					# otherwise, we'll need a different approach. Using Sub::Name would
196					# be fine in all cases, at the cost of introducing a dependency on
197					# an XS-using, non-core module. So instead we'll use string-eval to
198					# create a new subroutine that wraps $code.
199					if (_is_in_package($code, $into)) {
200	2	50µs	2	38µs	# spent 26µs (13+13) within Class::Method::Modifiers::BEGIN@200 which was called: # once (13µs+13µs) by Moo::Role::before at line 200 no strict 'refs'; # spent 26µs making 1 call to Class::Method::Modifiers::BEGIN@200 # spent 13µs making 1 call to strict::unimport
201					*{"$into\::$name"} = $code;
202					}
203					else {
204	2	184µs	2	33µs	# spent 23µs (12+11) within Class::Method::Modifiers::BEGIN@204 which was called: # once (12µs+11µs) by Moo::Role::before at line 204 no warnings 'closure'; # for 5.8.x # spent 23µs making 1 call to Class::Method::Modifiers::BEGIN@204 # spent 11µs making 1 call to warnings::unimport
205					my $attrs = _sub_attrs($code);
206					eval "package $into; sub $name $attrs { \$code->(\@_) }";
207					}
208					}
209					}
210
211					# spent 255µs within Class::Method::Modifiers::_sub_attrs which was called 6 times, avg 42µs/call: # 4 times (165µs+0s) by Class::Method::Modifiers::install_modifier at line 108, avg 41µs/call # 2 times (90µs+0s) by Class::Method::Modifiers::install_modifier at line 89, avg 45µs/call sub _sub_attrs {
212	6	2µs			my ($coderef) = @_;
213	6	4µs			local *_sub = $coderef;
214	6	1µs			local $@;
215	6	268µs			(eval 'sub { _sub = 1 }') ? ':lvalue' : '';
216					}
217
218					sub _is_in_package {
219					my ($coderef, $package) = @_;
220					require B;
221					my $cv = B::svref_2object($coderef);
222					return $cv->GV->STASH->NAME eq $package;
223					}
224
225	1	7µs			1;
226
227					__END__