← 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:40:10 2011

File /usr/lib/perl5/5.10.1/NEXT.pm
Statements Executed 74
Statement Execution Time 9.32ms
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
881781µs781µsNEXT::ELSEWHERE::::buildAUTOLOAD NEXT::ELSEWHERE::buildAUTOLOAD
221154µs154µsEVERY::ELSEWHERE::::buildAUTOLOADEVERY::ELSEWHERE::buildAUTOLOAD
111114µs544µsNEXT::::BEGIN@3 NEXT::BEGIN@3
111114µs165µsNEXT::::BEGIN@13 NEXT::BEGIN@13
11190µs135µsNEXT::::BEGIN@101 NEXT::BEGIN@101
11133µs45µsNEXT::::BEGIN@4 NEXT::BEGIN@4
11133µs81µsNEXT::::BEGIN@93 NEXT::BEGIN@93
11132µs78µsNEXT::::BEGIN@37 NEXT::BEGIN@37
11132µs139µsEVERY::::BEGIN@137 EVERY::BEGIN@137
11132µs81µsNEXT::::BEGIN@63 NEXT::BEGIN@63
11131µs79µsEVERY::::BEGIN@116 EVERY::BEGIN@116
11130µs83µsNEXT::::BEGIN@25 NEXT::BEGIN@25
11117µs17µsNEXT::::BEGIN@5 NEXT::BEGIN@5
0000s0sEVERY::::__ANON__[:181] EVERY::__ANON__[:181]
0000s0sNEXT::ELSEWHERE::::ancestors NEXT::ELSEWHERE::ancestors
0000s0sNEXT::ELSEWHERE::::ordered_ancestors NEXT::ELSEWHERE::ordered_ancestors
0000s0sNEXT::::__ANON__[:98] NEXT::__ANON__[:98]
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package NEXT;
214µs$VERSION = '0.64';
33341µs2973µs
# spent 544µs (114+429) within NEXT::BEGIN@3 which was called # once (114µs+429µs) by Class::C3::Adopt::NEXT::BEGIN@6 at line 3
use Carp;
# spent 544µs making 1 call to NEXT::BEGIN@3 # spent 429µs making 1 call to Exporter::import
43143µs257µs
# spent 45µs (33+12) within NEXT::BEGIN@4 which was called # once (33µs+12µs) by Class::C3::Adopt::NEXT::BEGIN@6 at line 4
use strict;
# spent 45µs making 1 call to NEXT::BEGIN@4 # spent 12µs making 1 call to strict::import
53245µs117µs
# spent 17µs within NEXT::BEGIN@5 which was called # once (17µs+0s) by Class::C3::Adopt::NEXT::BEGIN@6 at line 5
use overload ();
# spent 17µs making 1 call to NEXT::BEGIN@5
6
7sub NEXT::ELSEWHERE::ancestors
8{
9 my @inlist = shift;
10 my @outlist = ();
11 while (my $next = shift @inlist) {
12 push @outlist, $next;
133374µs2216µs
# spent 165µs (114+51) within NEXT::BEGIN@13 which was called # once (114µs+51µs) by Class::C3::Adopt::NEXT::BEGIN@6 at line 13
no strict 'refs';
# spent 165µs making 1 call to NEXT::BEGIN@13 # spent 51µs making 1 call to strict::unimport
14 unshift @inlist, @{"$outlist[-1]::ISA"};
15 }
16 return @outlist;
17}
18
19sub NEXT::ELSEWHERE::ordered_ancestors
20{
21 my @inlist = shift;
22 my @outlist = ();
23 while (my $next = shift @inlist) {
24 push @outlist, $next;
253570µs2136µs
# spent 83µs (30+53) within NEXT::BEGIN@25 which was called # once (30µs+53µs) by Class::C3::Adopt::NEXT::BEGIN@6 at line 25
no strict 'refs';
# spent 83µs making 1 call to NEXT::BEGIN@25 # spent 53µs making 1 call to strict::unimport
26 push @inlist, @{"$outlist[-1]::ISA"};
27 }
28 return sort { $a->isa($b) ? -1
29 : $b->isa($a) ? +1
30 : 0 } @outlist;
31}
32
33sub NEXT::ELSEWHERE::buildAUTOLOAD
34
# spent 781µs within NEXT::ELSEWHERE::buildAUTOLOAD which was called 8 times, avg 98µs/call: # once (251µs+0s) by Class::C3::Adopt::NEXT::BEGIN@6 at line 109 # once (162µs+0s) by Class::C3::Adopt::NEXT::BEGIN@6 at line 106 # once (125µs+0s) by Class::C3::Adopt::NEXT::BEGIN@6 at line 107 # once (66µs+0s) by Class::C3::Adopt::NEXT::BEGIN@6 at line 104 # once (65µs+0s) by Class::C3::Adopt::NEXT::BEGIN@6 at line 108 # once (41µs+0s) by Class::C3::Adopt::NEXT::BEGIN@6 at line 102 # once (37µs+0s) by Class::C3::Adopt::NEXT::BEGIN@6 at line 103 # once (33µs+0s) by Class::C3::Adopt::NEXT::BEGIN@6 at line 105
{
35834µs my $autoload_name = caller() . '::AUTOLOAD';
36
373759µs2124µs
# spent 78µs (32+46) within NEXT::BEGIN@37 which was called # once (32µs+46µs) by Class::C3::Adopt::NEXT::BEGIN@6 at line 37
no strict 'refs';
# spent 78µs making 1 call to NEXT::BEGIN@37 # spent 46µs making 1 call to strict::unimport
38 *{$autoload_name} = sub {
39 my ($self) = @_;
40 my $depth = 1;
41 until (((caller($depth))[3]||q{}) !~ /^\(eval\)$/) { $depth++ }
42 my $caller = (caller($depth))[3];
43 my $wanted = $NEXT::AUTOLOAD || $autoload_name;
44 undef $NEXT::AUTOLOAD;
45 my ($caller_class, $caller_method) = do { $caller =~ m{(.*)::(.*)}g };
46 my ($wanted_class, $wanted_method) = do { $wanted =~ m{(.*)::(.*)}g };
47 croak "Can't call $wanted from $caller"
48 unless $caller_method eq $wanted_method;
49
50 my $key = ref $self && overload::Overloaded($self)
51 ? overload::StrVal($self) : $self;
52
53 local ($NEXT::NEXT{$key,$wanted_method}, $NEXT::SEEN) =
54 ($NEXT::NEXT{$key,$wanted_method}, $NEXT::SEEN);
55
56 unless ($NEXT::NEXT{$key,$wanted_method}) {
57 my @forebears =
58 NEXT::ELSEWHERE::ancestors ref $self || $self,
59 $wanted_class;
60 while (@forebears) {
61 last if shift @forebears eq $caller_class
62 }
6331.18ms2131µs
# spent 81µs (32+50) within NEXT::BEGIN@63 which was called # once (32µs+50µs) by Class::C3::Adopt::NEXT::BEGIN@6 at line 63
no strict 'refs';
# spent 81µs making 1 call to NEXT::BEGIN@63 # spent 50µs making 1 call to strict::unimport
64 @{$NEXT::NEXT{$key,$wanted_method}} =
65 map {
66 my $stash = \%{"${_}::"};
67 ($stash->{$caller_method} && (*{$stash->{$caller_method}}{CODE}))
68 ? *{$stash->{$caller_method}}{CODE}
69 : () } @forebears
70 unless $wanted_method eq 'AUTOLOAD';
71 @{$NEXT::NEXT{$key,$wanted_method}} =
72 map {
73 my $stash = \%{"${_}::"};
74 ($stash->{AUTOLOAD} && (*{$stash->{AUTOLOAD}}{CODE}))
75 ? "${_}::AUTOLOAD"
76 : () } @forebears
77 unless @{$NEXT::NEXT{$key,$wanted_method}||[]};
78 $NEXT::SEEN->{$key,*{$caller}{CODE}}++;
79 }
80 my $call_method = shift @{$NEXT::NEXT{$key,$wanted_method}};
81 while (do { $wanted_class =~ /^NEXT\b.*\b(UNSEEN|DISTINCT)\b/ }
82 && defined $call_method
83 && $NEXT::SEEN->{$key,$call_method}++) {
84 $call_method = shift @{$NEXT::NEXT{$key,$wanted_method}};
85 }
86 unless (defined $call_method) {
87 return unless do { $wanted_class =~ /^NEXT:.*:ACTUAL/ };
88 (local $Carp::CarpLevel)++;
89 croak qq(Can't locate object method "$wanted_method" ),
90 qq(via package "$caller_class");
91 };
92 return $self->$call_method(@_[1..$#_]) if ref $call_method eq 'CODE';
933503µs2130µs
# spent 81µs (33+49) within NEXT::BEGIN@93 which was called # once (33µs+49µs) by Class::C3::Adopt::NEXT::BEGIN@6 at line 93
no strict 'refs';
# spent 81µs making 1 call to NEXT::BEGIN@93 # spent 48µs making 1 call to strict::unimport
94 do { ($wanted_method=${$caller_class."::AUTOLOAD"}) =~ s/.*::// }
95 if $wanted_method eq 'AUTOLOAD';
96 $$call_method = $caller_class."::NEXT::".$wanted_method;
97 return $call_method->(@_);
988913µs };
99}
100
1013777µs2181µs
# spent 135µs (90+45) within NEXT::BEGIN@101 which was called # once (90µs+45µs) by Class::C3::Adopt::NEXT::BEGIN@6 at line 101
no strict 'vars';
# spent 135µs making 1 call to NEXT::BEGIN@101 # spent 45µs making 1 call to strict::unimport
10218µs141µspackage NEXT; NEXT::ELSEWHERE::buildAUTOLOAD();
# spent 41µs making 1 call to NEXT::ELSEWHERE::buildAUTOLOAD
103234µs137µspackage NEXT::UNSEEN; @ISA = 'NEXT'; NEXT::ELSEWHERE::buildAUTOLOAD();
# spent 37µs making 1 call to NEXT::ELSEWHERE::buildAUTOLOAD
104225µs166µspackage NEXT::DISTINCT; @ISA = 'NEXT'; NEXT::ELSEWHERE::buildAUTOLOAD();
# spent 66µs making 1 call to NEXT::ELSEWHERE::buildAUTOLOAD
105225µs133µspackage NEXT::ACTUAL; @ISA = 'NEXT'; NEXT::ELSEWHERE::buildAUTOLOAD();
# spent 33µs making 1 call to NEXT::ELSEWHERE::buildAUTOLOAD
1062166µs1162µspackage NEXT::ACTUAL::UNSEEN; @ISA = 'NEXT'; NEXT::ELSEWHERE::buildAUTOLOAD();
# spent 162µs making 1 call to NEXT::ELSEWHERE::buildAUTOLOAD
107228µs1125µspackage NEXT::ACTUAL::DISTINCT; @ISA = 'NEXT'; NEXT::ELSEWHERE::buildAUTOLOAD();
# spent 125µs making 1 call to NEXT::ELSEWHERE::buildAUTOLOAD
108228µs165µspackage NEXT::UNSEEN::ACTUAL; @ISA = 'NEXT'; NEXT::ELSEWHERE::buildAUTOLOAD();
# spent 65µs making 1 call to NEXT::ELSEWHERE::buildAUTOLOAD
109224µs1251µspackage NEXT::DISTINCT::ACTUAL; @ISA = 'NEXT'; NEXT::ELSEWHERE::buildAUTOLOAD();
# spent 251µs making 1 call to NEXT::ELSEWHERE::buildAUTOLOAD
110
111package EVERY;
112
113
# spent 154µs within EVERY::ELSEWHERE::buildAUTOLOAD which was called 2 times, avg 77µs/call: # once (86µs+0s) by Class::C3::Adopt::NEXT::BEGIN@6 at line 185 # once (68µs+0s) by Class::C3::Adopt::NEXT::BEGIN@6 at line 184
sub EVERY::ELSEWHERE::buildAUTOLOAD {
11429µs my $autoload_name = caller() . '::AUTOLOAD';
115
11631.53ms2127µs
# spent 79µs (31+48) within EVERY::BEGIN@116 which was called # once (31µs+48µs) by Class::C3::Adopt::NEXT::BEGIN@6 at line 116
no strict 'refs';
# spent 79µs making 1 call to EVERY::BEGIN@116 # spent 48µs making 1 call to strict::unimport
117 *{$autoload_name} = sub {
118 my ($self) = @_;
119 my $depth = 1;
120 until (((caller($depth))[3]||q{}) !~ /^\(eval\)$/) { $depth++ }
121 my $caller = (caller($depth))[3];
122 my $wanted = $EVERY::AUTOLOAD || $autoload_name;
123 undef $EVERY::AUTOLOAD;
124 my ($wanted_class, $wanted_method) = do { $wanted =~ m{(.*)::(.*)}g };
125
126 my $key = ref($self) && overload::Overloaded($self)
127 ? overload::StrVal($self) : $self;
128
129 local $NEXT::ALREADY_IN_EVERY{$key,$wanted_method} =
130 $NEXT::ALREADY_IN_EVERY{$key,$wanted_method};
131
132 return if $NEXT::ALREADY_IN_EVERY{$key,$wanted_method}++;
133
134 my @forebears = NEXT::ELSEWHERE::ordered_ancestors ref $self || $self,
135 $wanted_class;
136 @forebears = reverse @forebears if do { $wanted_class =~ /\bLAST\b/ };
13731.31ms2246µs
# spent 139µs (32+107) within EVERY::BEGIN@137 which was called # once (32µs+107µs) by Class::C3::Adopt::NEXT::BEGIN@6 at line 137
no strict 'refs';
# spent 139µs making 1 call to EVERY::BEGIN@137 # spent 107µs making 1 call to strict::unimport
138 my %seen;
139 my @every = map { my $sub = "${_}::$wanted_method";
140 !*{$sub}{CODE} || $seen{$sub}++ ? () : $sub
141 } @forebears
142 unless $wanted_method eq 'AUTOLOAD';
143
144 my $want = wantarray;
145 if (@every) {
146 if ($want) {
147 return map {($_, [$self->$_(@_[1..$#_])])} @every;
148 }
149 elsif (defined $want) {
150 return { map {($_, scalar($self->$_(@_[1..$#_])))}
151 @every
152 };
153 }
154 else {
155 $self->$_(@_[1..$#_]) for @every;
156 return;
157 }
158 }
159
160 @every = map { my $sub = "${_}::AUTOLOAD";
161 !*{$sub}{CODE} || $seen{$sub}++ ? () : "${_}::AUTOLOAD"
162 } @forebears;
163 if ($want) {
164 return map { $$_ = ref($self)."::EVERY::".$wanted_method;
165 ($_, [$self->$_(@_[1..$#_])]);
166 } @every;
167 }
168 elsif (defined $want) {
169 return { map { $$_ = ref($self)."::EVERY::".$wanted_method;
170 ($_, scalar($self->$_(@_[1..$#_])))
171 } @every
172 };
173 }
174 else {
175 for (@every) {
176 $$_ = ref($self)."::EVERY::".$wanted_method;
177 $self->$_(@_[1..$#_]);
178 }
179 return;
180 }
1812188µs };
182}
183
184230µs168µspackage EVERY::LAST; @ISA = 'EVERY'; EVERY::ELSEWHERE::buildAUTOLOAD();
# spent 68µs making 1 call to EVERY::ELSEWHERE::buildAUTOLOAD
185235µs186µspackage EVERY; @ISA = 'NEXT'; EVERY::ELSEWHERE::buildAUTOLOAD();
# spent 86µs making 1 call to EVERY::ELSEWHERE::buildAUTOLOAD
186
187139µs1;
188
189__END__
190
191=head1 NAME
192
193NEXT.pm - Provide a pseudo-class NEXT (et al) that allows method redispatch
194
195
196=head1 SYNOPSIS
197
198 use NEXT;
199
200 package A;
201 sub A::method { print "$_[0]: A method\n"; $_[0]->NEXT::method() }
202 sub A::DESTROY { print "$_[0]: A dtor\n"; $_[0]->NEXT::DESTROY() }
203
204 package B;
205 use base qw( A );
206 sub B::AUTOLOAD { print "$_[0]: B AUTOLOAD\n"; $_[0]->NEXT::AUTOLOAD() }
207 sub B::DESTROY { print "$_[0]: B dtor\n"; $_[0]->NEXT::DESTROY() }
208
209 package C;
210 sub C::method { print "$_[0]: C method\n"; $_[0]->NEXT::method() }
211 sub C::AUTOLOAD { print "$_[0]: C AUTOLOAD\n"; $_[0]->NEXT::AUTOLOAD() }
212 sub C::DESTROY { print "$_[0]: C dtor\n"; $_[0]->NEXT::DESTROY() }
213
214 package D;
215 use base qw( B C );
216 sub D::method { print "$_[0]: D method\n"; $_[0]->NEXT::method() }
217 sub D::AUTOLOAD { print "$_[0]: D AUTOLOAD\n"; $_[0]->NEXT::AUTOLOAD() }
218 sub D::DESTROY { print "$_[0]: D dtor\n"; $_[0]->NEXT::DESTROY() }
219
220 package main;
221
222 my $obj = bless {}, "D";
223
224 $obj->method(); # Calls D::method, A::method, C::method
225 $obj->missing_method(); # Calls D::AUTOLOAD, B::AUTOLOAD, C::AUTOLOAD
226
227 # Clean-up calls D::DESTROY, B::DESTROY, A::DESTROY, C::DESTROY
228
229
230
231=head1 DESCRIPTION
232
233NEXT.pm adds a pseudoclass named C<NEXT> to any program
234that uses it. If a method C<m> calls C<$self-E<gt>NEXT::m()>, the call to
235C<m> is redispatched as if the calling method had not originally been found.
236
237In other words, a call to C<$self-E<gt>NEXT::m()> resumes the depth-first,
238left-to-right search of C<$self>'s class hierarchy that resulted in the
239original call to C<m>.
240
241Note that this is not the same thing as C<$self-E<gt>SUPER::m()>, which
242begins a new dispatch that is restricted to searching the ancestors
243of the current class. C<$self-E<gt>NEXT::m()> can backtrack
244past the current class -- to look for a suitable method in other
245ancestors of C<$self> -- whereas C<$self-E<gt>SUPER::m()> cannot.
246
247A typical use would be in the destructors of a class hierarchy,
248as illustrated in the synopsis above. Each class in the hierarchy
249has a DESTROY method that performs some class-specific action
250and then redispatches the call up the hierarchy. As a result,
251when an object of class D is destroyed, the destructors of I<all>
252its parent classes are called (in depth-first, left-to-right order).
253
254Another typical use of redispatch would be in C<AUTOLOAD>'ed methods.
255If such a method determined that it was not able to handle a
256particular call, it might choose to redispatch that call, in the
257hope that some other C<AUTOLOAD> (above it, or to its left) might
258do better.
259
260By default, if a redispatch attempt fails to find another method
261elsewhere in the objects class hierarchy, it quietly gives up and does
262nothing (but see L<"Enforcing redispatch">). This gracious acquiescence
263is also unlike the (generally annoying) behaviour of C<SUPER>, which
264throws an exception if it cannot redispatch.
265
266Note that it is a fatal error for any method (including C<AUTOLOAD>)
267to attempt to redispatch any method that does not have the
268same name. For example:
269
270 sub D::oops { print "oops!\n"; $_[0]->NEXT::other_method() }
271
272
273=head2 Enforcing redispatch
274
275It is possible to make C<NEXT> redispatch more demandingly (i.e. like
276C<SUPER> does), so that the redispatch throws an exception if it cannot
277find a "next" method to call.
278
279To do this, simple invoke the redispatch as:
280
281 $self->NEXT::ACTUAL::method();
282
283rather than:
284
285 $self->NEXT::method();
286
287The C<ACTUAL> tells C<NEXT> that there must actually be a next method to call,
288or it should throw an exception.
289
290C<NEXT::ACTUAL> is most commonly used in C<AUTOLOAD> methods, as a means to
291decline an C<AUTOLOAD> request, but preserve the normal exception-on-failure
292semantics:
293
294 sub AUTOLOAD {
295 if ($AUTOLOAD =~ /foo|bar/) {
296 # handle here
297 }
298 else { # try elsewhere
299 shift()->NEXT::ACTUAL::AUTOLOAD(@_);
300 }
301 }
302
303By using C<NEXT::ACTUAL>, if there is no other C<AUTOLOAD> to handle the
304method call, an exception will be thrown (as usually happens in the absence of
305a suitable C<AUTOLOAD>).
306
307
308=head2 Avoiding repetitions
309
310If C<NEXT> redispatching is used in the methods of a "diamond" class hierarchy:
311
312 # A B
313 # / \ /
314 # C D
315 # \ /
316 # E
317
318 use NEXT;
319
320 package A;
321 sub foo { print "called A::foo\n"; shift->NEXT::foo() }
322
323 package B;
324 sub foo { print "called B::foo\n"; shift->NEXT::foo() }
325
326 package C; @ISA = qw( A );
327 sub foo { print "called C::foo\n"; shift->NEXT::foo() }
328
329 package D; @ISA = qw(A B);
330 sub foo { print "called D::foo\n"; shift->NEXT::foo() }
331
332 package E; @ISA = qw(C D);
333 sub foo { print "called E::foo\n"; shift->NEXT::foo() }
334
335 E->foo();
336
337then derived classes may (re-)inherit base-class methods through two or
338more distinct paths (e.g. in the way C<E> inherits C<A::foo> twice --
339through C<C> and C<D>). In such cases, a sequence of C<NEXT> redispatches
340will invoke the multiply inherited method as many times as it is
341inherited. For example, the above code prints:
342
343 called E::foo
344 called C::foo
345 called A::foo
346 called D::foo
347 called A::foo
348 called B::foo
349
350(i.e. C<A::foo> is called twice).
351
352In some cases this I<may> be the desired effect within a diamond hierarchy,
353but in others (e.g. for destructors) it may be more appropriate to
354call each method only once during a sequence of redispatches.
355
356To cover such cases, you can redispatch methods via:
357
358 $self->NEXT::DISTINCT::method();
359
360rather than:
361
362 $self->NEXT::method();
363
364This causes the redispatcher to only visit each distinct C<method> method
365once. That is, to skip any classes in the hierarchy that it has
366already visited during redispatch. So, for example, if the
367previous example were rewritten:
368
369 package A;
370 sub foo { print "called A::foo\n"; shift->NEXT::DISTINCT::foo() }
371
372 package B;
373 sub foo { print "called B::foo\n"; shift->NEXT::DISTINCT::foo() }
374
375 package C; @ISA = qw( A );
376 sub foo { print "called C::foo\n"; shift->NEXT::DISTINCT::foo() }
377
378 package D; @ISA = qw(A B);
379 sub foo { print "called D::foo\n"; shift->NEXT::DISTINCT::foo() }
380
381 package E; @ISA = qw(C D);
382 sub foo { print "called E::foo\n"; shift->NEXT::DISTINCT::foo() }
383
384 E->foo();
385
386then it would print:
387
388 called E::foo
389 called C::foo
390 called A::foo
391 called D::foo
392 called B::foo
393
394and omit the second call to C<A::foo> (since it would not be distinct
395from the first call to C<A::foo>).
396
397Note that you can also use:
398
399 $self->NEXT::DISTINCT::ACTUAL::method();
400
401or:
402
403 $self->NEXT::ACTUAL::DISTINCT::method();
404
405to get both unique invocation I<and> exception-on-failure.
406
407Note that, for historical compatibility, you can also use
408C<NEXT::UNSEEN> instead of C<NEXT::DISTINCT>.
409
410
411=head2 Invoking all versions of a method with a single call
412
413Yet another pseudo-class that NEXT.pm provides is C<EVERY>.
414Its behaviour is considerably simpler than that of the C<NEXT> family.
415A call to:
416
417 $obj->EVERY::foo();
418
419calls I<every> method named C<foo> that the object in C<$obj> has inherited.
420That is:
421
422 use NEXT;
423
424 package A; @ISA = qw(B D X);
425 sub foo { print "A::foo " }
426
427 package B; @ISA = qw(D X);
428 sub foo { print "B::foo " }
429
430 package X; @ISA = qw(D);
431 sub foo { print "X::foo " }
432
433 package D;
434 sub foo { print "D::foo " }
435
436 package main;
437
438 my $obj = bless {}, 'A';
439 $obj->EVERY::foo(); # prints" A::foo B::foo X::foo D::foo
440
441Prefixing a method call with C<EVERY::> causes every method in the
442object's hierarchy with that name to be invoked. As the above example
443illustrates, they are not called in Perl's usual "left-most-depth-first"
444order. Instead, they are called "breadth-first-dependency-wise".
445
446That means that the inheritance tree of the object is traversed breadth-first
447and the resulting order of classes is used as the sequence in which methods
448are called. However, that sequence is modified by imposing a rule that the
449appropriate method of a derived class must be called before the same method of
450any ancestral class. That's why, in the above example, C<X::foo> is called
451before C<D::foo>, even though C<D> comes before C<X> in C<@B::ISA>.
452
453In general, there's no need to worry about the order of calls. They will be
454left-to-right, breadth-first, most-derived-first. This works perfectly for
455most inherited methods (including destructors), but is inappropriate for
456some kinds of methods (such as constructors, cloners, debuggers, and
457initializers) where it's more appropriate that the least-derived methods be
458called first (as more-derived methods may rely on the behaviour of their
459"ancestors"). In that case, instead of using the C<EVERY> pseudo-class:
460
461 $obj->EVERY::foo(); # prints" A::foo B::foo X::foo D::foo
462
463you can use the C<EVERY::LAST> pseudo-class:
464
465 $obj->EVERY::LAST::foo(); # prints" D::foo X::foo B::foo A::foo
466
467which reverses the order of method call.
468
469Whichever version is used, the actual methods are called in the same
470context (list, scalar, or void) as the original call via C<EVERY>, and return:
471
472=over
473
474=item *
475
476A hash of array references in list context. Each entry of the hash has the
477fully qualified method name as its key and a reference to an array containing
478the method's list-context return values as its value.
479
480=item *
481
482A reference to a hash of scalar values in scalar context. Each entry of the hash has the
483fully qualified method name as its key and the method's scalar-context return values as its value.
484
485=item *
486
487Nothing in void context (obviously).
488
489=back
490
491=head2 Using C<EVERY> methods
492
493The typical way to use an C<EVERY> call is to wrap it in another base
494method, that all classes inherit. For example, to ensure that every
495destructor an object inherits is actually called (as opposed to just the
496left-most-depth-first-est one):
497
498 package Base;
499 sub DESTROY { $_[0]->EVERY::Destroy }
500
501 package Derived1;
502 use base 'Base';
503 sub Destroy {...}
504
505 package Derived2;
506 use base 'Base', 'Derived1';
507 sub Destroy {...}
508
509et cetera. Every derived class than needs its own clean-up
510behaviour simply adds its own C<Destroy> method (I<not> a C<DESTROY> method),
511which the call to C<EVERY::LAST::Destroy> in the inherited destructor
512then correctly picks up.
513
514Likewise, to create a class hierarchy in which every initializer inherited by
515a new object is invoked:
516
517 package Base;
518 sub new {
519 my ($class, %args) = @_;
520 my $obj = bless {}, $class;
521 $obj->EVERY::LAST::Init(\%args);
522 }
523
524 package Derived1;
525 use base 'Base';
526 sub Init {
527 my ($argsref) = @_;
528 ...
529 }
530
531 package Derived2;
532 use base 'Base', 'Derived1';
533 sub Init {
534 my ($argsref) = @_;
535 ...
536 }
537
538et cetera. Every derived class than needs some additional initialization
539behaviour simply adds its own C<Init> method (I<not> a C<new> method),
540which the call to C<EVERY::LAST::Init> in the inherited constructor
541then correctly picks up.
542
543
544=head1 AUTHOR
545
546Damian Conway (damian@conway.org)
547
548=head1 BUGS AND IRRITATIONS
549
550Because it's a module, not an integral part of the interpreter, NEXT.pm
551has to guess where the surrounding call was found in the method
552look-up sequence. In the presence of diamond inheritance patterns
553it occasionally guesses wrong.
554
555It's also too slow (despite caching).
556
557Comment, suggestions, and patches welcome.
558
559=head1 COPYRIGHT
560
561 Copyright (c) 2000-2001, Damian Conway. All Rights Reserved.
562 This module is free software. It may be used, redistributed
563 and/or modified under the same terms as Perl itself.
Report produced by the NYTProf 3.11 Perl profiler, developed by Tim Bunce and Adam Kaplan.