← Index
NYTProf Performance Profile   « block view • line view • sub view »
For /usr/bin/epoll_server.pl
  Run on Wed Jan 5 05:34:33 2011
Reported on Wed Jan 5 05:35:55 2011

File /usr/lib/perl5/vendor_perl/5.10.0/Class/C3/Adopt/NEXT.pm
Statements Executed 37
Statement Execution Time 3.11ms
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1118.27ms10.7msClass::C3::Adopt::NEXT::::BEGIN@6Class::C3::Adopt::NEXT::BEGIN@6
111103µs109µsClass::C3::Adopt::NEXT::::BEGIN@7Class::C3::Adopt::NEXT::BEGIN@7
11153µs67µsCatalyst::Component::::BEGIN@1 Catalyst::Component::BEGIN@1
11147µs100µsClass::C3::Adopt::NEXT::::BEGIN@21Class::C3::Adopt::NEXT::BEGIN@21
11146µs107µsCatalyst::Component::::BEGIN@2 Catalyst::Component::BEGIN@2
11131µs155µsClass::C3::Adopt::NEXT::::BEGIN@8Class::C3::Adopt::NEXT::BEGIN@8
11130µs365µsClass::C3::Adopt::NEXT::::BEGIN@9Class::C3::Adopt::NEXT::BEGIN@9
22228µs28µsClass::C3::Adopt::NEXT::::importClass::C3::Adopt::NEXT::import
0000s0sClass::C3::Adopt::NEXT::::__ANON__[:45]Class::C3::Adopt::NEXT::__ANON__[:45]
0000s0sClass::C3::Adopt::NEXT::::__ANON__[:59]Class::C3::Adopt::NEXT::__ANON__[:59]
0000s0sClass::C3::Adopt::NEXT::::unimportClass::C3::Adopt::NEXT::unimport
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
13211µs281µs
# spent 67µs (53+14) within Catalyst::Component::BEGIN@1 which was called # once (53µs+14µs) by Catalyst::Component::BEGIN@7 at line 1
use strict;
# spent 67µs making 1 call to Catalyst::Component::BEGIN@1 # spent 14µs making 1 call to strict::import
23183µs2168µs
# spent 107µs (46+61) within Catalyst::Component::BEGIN@2 which was called # once (46µs+61µs) by Catalyst::Component::BEGIN@7 at line 2
use warnings;
# spent 107µs making 1 call to Catalyst::Component::BEGIN@2 # spent 61µs making 1 call to warnings::import
3
4package Class::C3::Adopt::NEXT;
5
63499µs210.7ms
# spent 10.7ms (8.27+2.39) within Class::C3::Adopt::NEXT::BEGIN@6 which was called # once (8.27ms+2.39ms) by Catalyst::Component::BEGIN@7 at line 6
use NEXT;
# spent 10.7ms making 1 call to Class::C3::Adopt::NEXT::BEGIN@6 # spent 10µs making 1 call to UNIVERSAL::import
73102µs2116µs
# spent 109µs (103+7) within Class::C3::Adopt::NEXT::BEGIN@7 which was called # once (103µs+7µs) by Catalyst::Component::BEGIN@7 at line 7
use MRO::Compat;
# spent 109µs making 1 call to Class::C3::Adopt::NEXT::BEGIN@7 # spent 7µs making 1 call to UNIVERSAL::import
8383µs2278µs
# spent 155µs (31+124) within Class::C3::Adopt::NEXT::BEGIN@8 which was called # once (31µs+124µs) by Catalyst::Component::BEGIN@7 at line 8
use List::MoreUtils qw/none/;
# spent 155µs making 1 call to Class::C3::Adopt::NEXT::BEGIN@8 # spent 124µs making 1 call to Exporter::import
93183µs2699µs
# spent 365µs (30+335) within Class::C3::Adopt::NEXT::BEGIN@9 which was called # once (30µs+335µs) by Catalyst::Component::BEGIN@7 at line 9
use warnings::register;
# spent 365µs making 1 call to Class::C3::Adopt::NEXT::BEGIN@9 # spent 334µs making 1 call to warnings::register::import
10
1113µsour $VERSION = '0.12';
12
13{
1425µs my %c3_mro_ok;
1511µs my %warned_for;
1612µs my @no_warn_regexes;
17
18 {
19239µs17µs my $orig = NEXT->can('AUTOLOAD');
# spent 7µs making 1 call to UNIVERSAL::can
20
2131.64ms2152µs
# spent 100µs (47+53) within Class::C3::Adopt::NEXT::BEGIN@21 which was called # once (47µs+53µs) by Catalyst::Component::BEGIN@7 at line 21
no warnings 'redefine';
# spent 100µs making 1 call to Class::C3::Adopt::NEXT::BEGIN@21 # spent 53µs making 1 call to warnings::unimport
22 *NEXT::AUTOLOAD = sub {
23 my $class = ref $_[0] || $_[0];
24 my $caller = caller();
25
26 # 'NEXT::AUTOLOAD' is cargo-culted from C::P::C3, I have no idea if/why it's needed
27 my $wanted = our $AUTOLOAD || 'NEXT::AUTOLOAD';
28 my ($wanted_class) = $wanted =~ m{(.*)::};
29
30 unless (exists $c3_mro_ok{$class}) {
31 eval { mro::get_linear_isa($class, 'c3') };
32 if (my $error = $@) {
33 warn "Class::C3::calculateMRO('${class}') Error: '${error}';"
34 . ' Falling back to plain NEXT.pm behaviour for this class';
35 $c3_mro_ok{$class} = 0;
36 }
37 else {
38 $c3_mro_ok{$class} = 1;
39 }
40 }
41
42 if (length $c3_mro_ok{$class} && $c3_mro_ok{$class}) {
43 unless ($warned_for{$caller}) {
44 $warned_for{$caller} = 1;
45 if (!@no_warn_regexes || none { $caller =~ $_ } @no_warn_regexes) {
46 warnings::warnif("${caller} uses NEXT, which is deprecated. Please see "
47 . "the Class::C3::Adopt::NEXT documentation for details. NEXT used ");
48 }
49 }
50 }
51
52 unless ($c3_mro_ok{$class}) {
53 $NEXT::AUTOLOAD = $wanted;
54 goto &$orig;
55 }
56
57 goto &next::method if $wanted_class =~ /^NEXT:.*:ACTUAL/;
58 goto &maybe::next::method;
59130µs };
60
61148µs *NEXT::ACTUAL::AUTOLOAD = \&NEXT::AUTOLOAD;
62 }
63
64
# spent 28µs within Class::C3::Adopt::NEXT::import which was called 2 times, avg 14µs/call: # once (17µs+0s) by Catalyst::Component::BEGIN@7 at line 7 of Catalyst/Component.pm # once (11µs+0s) by Catalyst::BEGIN@28 at line 28 of Catalyst.pm
sub import {
65664µs my ($class, @args) = @_;
66 my $target = caller();
67
68 for my $arg (@args) {
69 $warned_for{$target} = 1
70 if $arg eq '-no_warn';
71 }
72 }
73
74 sub unimport {
75 my $class = shift;
76 my @strings = grep { !ref $_ || ref($_) ne 'Regexp' } @_;
77 my @regexes = grep { ref($_) && ref($_) eq 'Regexp' } @_;
78 @c3_mro_ok{@strings} = ('') x @strings;
79 push @no_warn_regexes, @regexes;
80 }
81}
82
83119µs1;
84
85__END__
86
87=head1 NAME
88
89Class::C3::Adopt::NEXT - make NEXT suck less
90
91=head1 SYNOPSIS
92
93 package MyApp::Plugin::FooBar;
94 #use NEXT;
95 use Class::C3::Adopt::NEXT;
96 # or 'use Class::C3::Adopt::NEXT -no_warn;' to suppress warnings
97
98 # Or use warnings::register
99 # no warnings 'Class::C3::Adopt::NEXT';
100
101 # Or suppress warnings in a set of modules from one place
102 # no Class::C3::Adopt::NEXT qw/ Module1 Module2 Module3 /;
103 # Or suppress using a regex
104 # no Class::C3::Adopt::NEXT qr/^Module\d$/;
105
106 sub a_method {
107 my ($self) = @_;
108 # Do some stuff
109
110 # Re-dispatch method
111 # Note that this will generate a warning the _first_ time the package
112 # uses NEXT unless you un comment the 'no warnings' line above.
113 $self->NEXT::method();
114 }
115
116=head1 DESCRIPTION
117
118L<NEXT> was a good solution a few years ago, but isn't any more. It's slow,
119and the order in which it re-dispatches methods appears random at times. It
120also encourages bad programming practices, as you end up with code to
121re-dispatch methods when all you really wanted to do was run some code before
122or after a method fired.
123
124However, if you have a large application, then weaning yourself off C<NEXT>
125isn't easy.
126
127This module is intended as a drop-in replacement for NEXT, supporting the same
128interface, but using L<Class::C3> to do the hard work. You can then write new
129code without C<NEXT>, and migrate individual source files to use C<Class::C3>
130or method modifiers as appropriate, at whatever pace you're comfortable with.
131
132=head1 WARNINGS
133
134This module will warn once for each package using NEXT. It uses
135L<warnings::register>, and so can be disabled like by adding C<no warnings
136'Class::C3::Adopt::NEXT';> to each package which generates a warning, or adding
137C<use Class::C3::Adopt::NEXT -no_warn;>, or disable multiple modules at once by
138saying:
139
140 no Class::C3::Adopt::NEXT qw/ Module1 Module2 Module3 /;
141
142somewhere before the warnings are first triggered. You can also setup entire
143name spaces of modules which will not warn using a regex, e.g.
144
145 no Class::C3::Adopt::NEXT qr/^Module\d$/;
146
147=head1 MIGRATING
148
149=head2 Current code using NEXT
150
151You add C<use MRO::Compat> to the top of a package as you start converting it,
152and gradually replace your calls to C<NEXT::method()> with
153C<maybe::next::method()>, and calls to C<NEXT::ACTUAL::method()> with
154C<next::method()>.
155
156Example:
157
158 sub yourmethod {
159 my $self = shift;
160
161 # $self->NEXT::yourmethod(@_); becomes
162 $self->maybe::next::method();
163 }
164
165 sub othermethod {
166 my $self = shift;
167
168 # $self->NEXT::ACTUAL::yourmethodname(); becomes
169 $self->next::method();
170 }
171
172On systems with L<Class::C3::XS> present, this will automatically be used to
173speed up method re-dispatch. If you are running perl version 5.9.5 or greater
174then the C3 method resolution algorithm is included in perl. Correct use of
175L<MRO::Compat> as shown above allows your code to be seamlessly forward and
176backwards compatible, taking advantage of native versions if available, but
177falling back to using pure perl C<Class::C3>.
178
179=head2 Writing new code
180
181Use L<Moose> and make all of your plugins L<Moose::Roles|Moose::Role>, then use
182method modifiers to wrap methods.
183
184Example:
185
186 package MyApp::Role::FooBar;
187 use Moose::Role;
188
189 before 'a_method' => sub {
190 my ($self) = @_;
191 # Do some stuff
192 };
193
194 around 'a_method' => sub {
195 my $orig = shift;
196 my $self = shift;
197 # Do some stuff before
198 my $ret = $self->$orig(@_); # Run wrapped method (or not!)
199 # Do some stuff after
200 return $ret;
201 };
202
203 package MyApp;
204 use Moose;
205
206 with 'MyApp::Role::FooBar';
207
208=head1 CAVEATS
209
210There are some inheritance hierarchies that it is possible to create which
211cannot be resolved to a simple C3 hierarchy. In that case, this module will
212fall back to using C<NEXT>. In this case a warning will be emitted.
213
214Because calculating the MRO of every class every time C<< ->NEXT::foo >> is
215used from within it is too expensive, runtime manipulations of C<@ISA> are
216prohibited.
217
218=head1 FUNCTIONS
219
220This module replaces C<NEXT::AUTOLOAD> with it's own version. If warnings are
221enabled then a warning will be emitted on the first use of C<NEXT> by each
222package.
223
224=head1 SEE ALSO
225
226L<MRO::Compat> and L<Class::C3> for method re-dispatch and L<Moose> for method
227modifiers and L<roles|Moose::Role>.
228
229L<NEXT> for documentation on the functionality you'll be removing.
230
231=head1 AUTHORS
232
233Florian Ragwitz C<rafl@debian.org>
234
235Tomas Doran C<bobtfish@bobtfish.net>
236
237=head1 COPYRIGHT AND LICENSE
238
239Copyright (c) 2008, 2009 Florian Ragwitz
240
241You may distribute this code under the same terms as Perl itself.
242
243=cut
Report produced by the NYTProf 3.11 Perl profiler, developed by Tim Bunce and Adam Kaplan.