10 push @outlist, shift @inlist;
12 unshift @inlist, @{"$outlist[-1]::ISA"};
20 my $caller = (caller(1))[3];
21 my $wanted = $NEXT::AUTOLOAD || 'NEXT::AUTOLOAD';
22 undef $NEXT::AUTOLOAD;
23 my ($caller_class, $caller_method) = $caller =~ m{(.*)::(.*)}g;
24 my ($wanted_class, $wanted_method) = $wanted =~ m{(.*)::(.*)}g;
25 croak "Can't call $wanted from $caller"
26 unless $caller_method eq $wanted_method;
28 local $NEXT::NEXT{$self,$wanted_method} =
29 $NEXT::NEXT{$self,$wanted_method};
31 unless (@{$NEXT::NEXT{$self,$wanted_method}||[]}) {
32 my @forebears = ancestors ref $self;
34 last if shift @forebears eq $caller_class
37 @{$NEXT::NEXT{$self,$wanted_method}} =
38 map { *{"${_}::$caller_method"}{CODE}||() } @forebears
39 unless $wanted_method eq 'AUTOLOAD';
40 @{$NEXT::NEXT{$self,$wanted_method}} =
41 map { (*{"${_}::AUTOLOAD"}{CODE}) ?
42 "${_}::AUTOLOAD" : () } @forebears
43 unless @{$NEXT::NEXT{$self,$wanted_method}||[]};
45 my $call_method = shift @{$NEXT::NEXT{$self,$wanted_method}};
46 return unless defined $call_method;
47 if (ref $call_method eq 'CODE') {
48 return shift()->$call_method(@_)
52 ${$call_method} = $caller_method eq 'AUTOLOAD' && ${"${caller_class}::AUTOLOAD"} || $wanted;
53 return $call_method->(@_);
63 NEXT.pm - Provide a pseudo-class NEXT that allows method redispatch
71 sub A::method { print "$_[0]: A method\n"; $_[0]->NEXT::method() }
72 sub A::DESTROY { print "$_[0]: A dtor\n"; $_[0]->NEXT::DESTROY() }
76 sub B::AUTOLOAD { print "$_[0]: B AUTOLOAD\n"; $_[0]->NEXT::AUTOLOAD() }
77 sub B::DESTROY { print "$_[0]: B dtor\n"; $_[0]->NEXT::DESTROY() }
80 sub C::method { print "$_[0]: C method\n"; $_[0]->NEXT::method() }
81 sub C::AUTOLOAD { print "$_[0]: C AUTOLOAD\n"; $_[0]->NEXT::AUTOLOAD() }
82 sub C::DESTROY { print "$_[0]: C dtor\n"; $_[0]->NEXT::DESTROY() }
86 sub D::method { print "$_[0]: D method\n"; $_[0]->NEXT::method() }
87 sub D::AUTOLOAD { print "$_[0]: D AUTOLOAD\n"; $_[0]->NEXT::AUTOLOAD() }
88 sub D::DESTROY { print "$_[0]: D dtor\n"; $_[0]->NEXT::DESTROY() }
92 my $obj = bless {}, "D";
94 $obj->method(); # Calls D::method, A::method, C::method
95 $obj->missing_method(); # Calls D::AUTOLOAD, B::AUTOLOAD, C::AUTOLOAD
97 # Clean-up calls D::DESTROY, B::DESTROY, A::DESTROY, C::DESTROY
102 NEXT.pm adds a pseudoclass named C<NEXT> to any program
103 that uses it. If a method C<m> calls C<$self->NEXT::m()>, the call to
104 C<m> is redispatched as if the calling method had not originally been found.
106 In other words, a call to C<$self->NEXT::m()> resumes the depth-first,
107 left-to-right search of C<$self>'s class hierarchy that resulted in the
108 original call to C<m>.
110 Note that this is not the same thing as C<$self->SUPER::m()>, which
111 begins a new dispatch that is restricted to searching the ancestors
112 of the current class. C<$self->NEXT::m()> can backtrack
113 past the current class -- to look for a suitable method in other
114 ancestors of C<$self> -- whereas C<$self->SUPER::m()> cannot.
116 A typical use would be in the destructors of a class hierarchy,
117 as illustrated in the synopsis above. Each class in the hierarchy
118 has a DESTROY method that performs some class-specific action
119 and then redispatches the call up the hierarchy. As a result,
120 when an object of class D is destroyed, the destructors of I<all>
121 its parent classes are called (in depth-first, left-to-right order).
123 Another typical use of redispatch would be in C<AUTOLOAD>'ed methods.
124 If such a method determined that it was not able to handle a
125 particular call, it might choose to redispatch that call, in the
126 hope that some other C<AUTOLOAD> (above it, or to its left) might
129 Note that it is a fatal error for any method (including C<AUTOLOAD>)
130 to attempt to redispatch any method except itself. For example:
132 sub D::oops { print "oops!\n"; $_[0]->NEXT::other_method() }
137 Damian Conway (damian@conway.org)
139 =head1 BUGS AND IRRITATIONS
141 Because it's a module, not an integral part of the interpreter, NEXT.pm
142 has to guess where the surrounding call was found in the method
143 look-up sequence. In the presence of diamond inheritance patterns
144 it occasionally guesses wrong.
146 It's also too slow (despite caching).
148 Comment, suggestions, and patches welcome.
152 Copyright (c) 2000-2001, Damian Conway. All Rights Reserved.
153 This module is free software. It may be used, redistributed
154 and/or modified under the same terms as Perl itself.