6 sub NEXT::ELSEWHERE::ancestors
10 while (my $next = shift @inlist) {
13 unshift @inlist, @{"$outlist[-1]::ISA"};
21 my $caller = (caller(1))[3];
22 my $wanted = $NEXT::AUTOLOAD || 'NEXT::AUTOLOAD';
23 undef $NEXT::AUTOLOAD;
24 my ($caller_class, $caller_method) = $caller =~ m{(.*)::(.*)}g;
25 my ($wanted_class, $wanted_method) = $wanted =~ m{(.*)::(.*)}g;
26 croak "Can't call $wanted from $caller"
27 unless $caller_method eq $wanted_method;
29 local ($NEXT::NEXT{$self,$wanted_method}, $NEXT::SEEN) =
30 ($NEXT::NEXT{$self,$wanted_method}, $NEXT::SEEN);
33 unless ($NEXT::NEXT{$self,$wanted_method}) {
35 NEXT::ELSEWHERE::ancestors ref $self || $self,
38 last if shift @forebears eq $caller_class
41 @{$NEXT::NEXT{$self,$wanted_method}} =
42 map { *{"${_}::$caller_method"}{CODE}||() } @forebears
43 unless $wanted_method eq 'AUTOLOAD';
44 @{$NEXT::NEXT{$self,$wanted_method}} =
45 map { (*{"${_}::AUTOLOAD"}{CODE}) ? "${_}::AUTOLOAD" : ()} @forebears
46 unless @{$NEXT::NEXT{$self,$wanted_method}||[]};
47 $NEXT::SEEN->{$self,*{$caller}{CODE}}++;
49 my $call_method = shift @{$NEXT::NEXT{$self,$wanted_method}};
50 while ($wanted_class =~ /^NEXT:.*:(UNSEEN|DISTINCT):/ && defined $call_method
51 && $NEXT::SEEN->{$self,$call_method}++) {
52 $call_method = shift @{$NEXT::NEXT{$self,$wanted_method}};
54 unless (defined $call_method) {
55 return unless $wanted_class =~ /^NEXT:.*:ACTUAL/;
56 (local $Carp::CarpLevel)++;
57 croak qq(Can't locate object method "$wanted_method" ),
58 qq(via package "$caller_class");
60 return $self->$call_method(@_[1..$#_]) if ref $call_method eq 'CODE';
62 ($wanted_method=${$caller_class."::AUTOLOAD"}) =~ s/.*:://
63 if $wanted_method eq 'AUTOLOAD';
64 $$call_method = $caller_class."::NEXT::".$wanted_method;
65 return $call_method->(@_);
69 package NEXT::UNSEEN; @ISA = 'NEXT';
70 package NEXT::DISTINCT; @ISA = 'NEXT';
71 package NEXT::ACTUAL; @ISA = 'NEXT';
72 package NEXT::ACTUAL::UNSEEN; @ISA = 'NEXT';
73 package NEXT::ACTUAL::DISTINCT; @ISA = 'NEXT';
74 package NEXT::UNSEEN::ACTUAL; @ISA = 'NEXT';
75 package NEXT::DISTINCT::ACTUAL; @ISA = 'NEXT';
76 package EVERY; @ISA = 'NEXT';
84 NEXT.pm - Provide a pseudo-class NEXT that allows method redispatch
92 sub A::method { print "$_[0]: A method\n"; $_[0]->NEXT::method() }
93 sub A::DESTROY { print "$_[0]: A dtor\n"; $_[0]->NEXT::DESTROY() }
97 sub B::AUTOLOAD { print "$_[0]: B AUTOLOAD\n"; $_[0]->NEXT::AUTOLOAD() }
98 sub B::DESTROY { print "$_[0]: B dtor\n"; $_[0]->NEXT::DESTROY() }
101 sub C::method { print "$_[0]: C method\n"; $_[0]->NEXT::method() }
102 sub C::AUTOLOAD { print "$_[0]: C AUTOLOAD\n"; $_[0]->NEXT::AUTOLOAD() }
103 sub C::DESTROY { print "$_[0]: C dtor\n"; $_[0]->NEXT::DESTROY() }
107 sub D::method { print "$_[0]: D method\n"; $_[0]->NEXT::method() }
108 sub D::AUTOLOAD { print "$_[0]: D AUTOLOAD\n"; $_[0]->NEXT::AUTOLOAD() }
109 sub D::DESTROY { print "$_[0]: D dtor\n"; $_[0]->NEXT::DESTROY() }
113 my $obj = bless {}, "D";
115 $obj->method(); # Calls D::method, A::method, C::method
116 $obj->missing_method(); # Calls D::AUTOLOAD, B::AUTOLOAD, C::AUTOLOAD
118 # Clean-up calls D::DESTROY, B::DESTROY, A::DESTROY, C::DESTROY
123 NEXT.pm adds a pseudoclass named C<NEXT> to any program
124 that uses it. If a method C<m> calls C<$self->NEXT::m()>, the call to
125 C<m> is redispatched as if the calling method had not originally been found.
127 In other words, a call to C<$self->NEXT::m()> resumes the depth-first,
128 left-to-right search of C<$self>'s class hierarchy that resulted in the
129 original call to C<m>.
131 Note that this is not the same thing as C<$self->SUPER::m()>, which
132 begins a new dispatch that is restricted to searching the ancestors
133 of the current class. C<$self->NEXT::m()> can backtrack
134 past the current class -- to look for a suitable method in other
135 ancestors of C<$self> -- whereas C<$self->SUPER::m()> cannot.
137 A typical use would be in the destructors of a class hierarchy,
138 as illustrated in the synopsis above. Each class in the hierarchy
139 has a DESTROY method that performs some class-specific action
140 and then redispatches the call up the hierarchy. As a result,
141 when an object of class D is destroyed, the destructors of I<all>
142 its parent classes are called (in depth-first, left-to-right order).
144 Another typical use of redispatch would be in C<AUTOLOAD>'ed methods.
145 If such a method determined that it was not able to handle a
146 particular call, it might choose to redispatch that call, in the
147 hope that some other C<AUTOLOAD> (above it, or to its left) might
150 By default, if a redispatch attempt fails to find another method
151 elsewhere in the objects class hierarchy, it quietly gives up and does
152 nothing (but see L<"Enforcing redispatch">). This gracious acquiesence
153 is also unlike the (generally annoying) behaviour of C<SUPER>, which
154 throws an exception if it cannot redispatch.
156 Note that it is a fatal error for any method (including C<AUTOLOAD>)
157 to attempt to redispatch any method that does not have the
158 same name. For example:
160 sub D::oops { print "oops!\n"; $_[0]->NEXT::other_method() }
163 =head2 Enforcing redispatch
165 It is possible to make C<NEXT> redispatch more demandingly (i.e. like
166 C<SUPER> does), so that the redispatch throws an exception if it cannot
167 find a "next" method to call.
169 To do this, simple invoke the redispatch as:
171 $self->NEXT::ACTUAL::method();
175 $self->NEXT::method();
177 The C<ACTUAL> tells C<NEXT> that there must actually be a next method to call,
178 or it should throw an exception.
180 C<NEXT::ACTUAL> is most commonly used in C<AUTOLOAD> methods, as a means to
181 decline an C<AUTOLOAD> request, but preserve the normal exception-on-failure
185 if ($AUTOLOAD =~ /foo|bar/) {
188 else { # try elsewhere
189 shift()->NEXT::ACTUAL::AUTOLOAD(@_);
193 By using C<NEXT::ACTUAL>, if there is no other C<AUTOLOAD> to handle the
194 method call, an exception will be thrown (as usually happens in the absence of
195 a suitable C<AUTOLOAD>).
198 =head2 Avoiding repetitions
200 If C<NEXT> redispatching is used in the methods of a "diamond" class hierarchy:
211 sub foo { print "called A::foo\n"; shift->NEXT::foo() }
214 sub foo { print "called B::foo\n"; shift->NEXT::foo() }
216 package C; @ISA = qw( A );
217 sub foo { print "called C::foo\n"; shift->NEXT::foo() }
219 package D; @ISA = qw(A B);
220 sub foo { print "called D::foo\n"; shift->NEXT::foo() }
222 package E; @ISA = qw(C D);
223 sub foo { print "called E::foo\n"; shift->NEXT::foo() }
227 then derived classes may (re-)inherit base-class methods through two or
228 more distinct paths (e.g. in the way C<E> inherits C<A::foo> twice --
229 through C<C> and C<D>). In such cases, a sequence of C<NEXT> redispatches
230 will invoke the multiply inherited method as many times as it is
231 inherited. For example, the above code prints:
240 (i.e. C<A::foo> is called twice).
242 In some cases this I<may> be the desired effect within a diamond hierarchy,
243 but in others (e.g. for destructors) it may be more appropriate to
244 call each method only once during a sequence of redispatches.
246 To cover such cases, you can redispatch methods via:
248 $self->NEXT::DISTINCT::method();
252 $self->NEXT::method();
254 This causes the redispatcher to only visit each distinct C<method> method
255 once. That is, to skip any classes in the hierarchy that it has
256 already visited during redispatch. So, for example, if the
257 previous example were rewritten:
260 sub foo { print "called A::foo\n"; shift->NEXT::DISTINCT::foo() }
263 sub foo { print "called B::foo\n"; shift->NEXT::DISTINCT::foo() }
265 package C; @ISA = qw( A );
266 sub foo { print "called C::foo\n"; shift->NEXT::DISTINCT::foo() }
268 package D; @ISA = qw(A B);
269 sub foo { print "called D::foo\n"; shift->NEXT::DISTINCT::foo() }
271 package E; @ISA = qw(C D);
272 sub foo { print "called E::foo\n"; shift->NEXT::DISTINCT::foo() }
284 and omit the second call to C<A::foo> (since it would not be distinct
285 from the first call to C<A::foo>).
287 Note that you can also use:
289 $self->NEXT::DISTINCT::ACTUAL::method();
293 $self->NEXT::ACTUAL::DISTINCT::method();
295 to get both unique invocation I<and> exception-on-failure.
297 Note that, for historical compatibility, you can also use
298 C<NEXT::UNSEEN> instead of C<NEXT::DISTINCT>.
302 Damian Conway (damian@conway.org)
304 =head1 BUGS AND IRRITATIONS
306 Because it's a module, not an integral part of the interpreter, NEXT.pm
307 has to guess where the surrounding call was found in the method
308 look-up sequence. In the presence of diamond inheritance patterns
309 it occasionally guesses wrong.
311 It's also too slow (despite caching).
313 Comment, suggestions, and patches welcome.
317 Copyright (c) 2000-2001, Damian Conway. All Rights Reserved.
318 This module is free software. It may be used, redistributed
319 and/or modified under the same terms as Perl itself.