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 @{$NEXT::NEXT{$self,$wanted_method}} =
40 map { *{"${_}::AUTOLOAD"}{CODE}||() } @forebears
41 unless @{$NEXT::NEXT{$self,$wanted_method}};
43 $wanted_method = shift @{$NEXT::NEXT{$self,$wanted_method}};
44 return shift()->$wanted_method(@_) if $wanted_method;
54 NEXT.pm - Provide a pseudo-class NEXT that allows method redispatch
62 sub A::method { print "$_[0]: A method\n"; $_[0]->NEXT::method() }
63 sub A::DESTROY { print "$_[0]: A dtor\n"; $_[0]->NEXT::DESTROY() }
67 sub B::AUTOLOAD { print "$_[0]: B AUTOLOAD\n"; $_[0]->NEXT::AUTOLOAD() }
68 sub B::DESTROY { print "$_[0]: B dtor\n"; $_[0]->NEXT::DESTROY() }
71 sub C::method { print "$_[0]: C method\n"; $_[0]->NEXT::method() }
72 sub C::AUTOLOAD { print "$_[0]: C AUTOLOAD\n"; $_[0]->NEXT::AUTOLOAD() }
73 sub C::DESTROY { print "$_[0]: C dtor\n"; $_[0]->NEXT::DESTROY() }
77 sub D::method { print "$_[0]: D method\n"; $_[0]->NEXT::method() }
78 sub D::AUTOLOAD { print "$_[0]: D AUTOLOAD\n"; $_[0]->NEXT::AUTOLOAD() }
79 sub D::DESTROY { print "$_[0]: D dtor\n"; $_[0]->NEXT::DESTROY() }
83 my $obj = bless {}, "D";
85 $obj->method(); # Calls D::method, A::method, C::method
86 $obj->missing_method(); # Calls D::AUTOLOAD, B::AUTOLOAD, C::AUTOLOAD
88 # Clean-up calls D::DESTROY, B::DESTROY, A::DESTROY, C::DESTROY
93 NEXT.pm adds a pseudoclass named C<NEXT> to any program
94 that uses it. If a method C<m> calls C<$self->NEXT::m()>, the call to
95 C<m> is redispatched as if the calling method had not originally been found.
97 In other words, a call to C<$self->NEXT::m()> resumes the depth-first,
98 left-to-right search of parent classes that resulted in the original
101 A typical use would be in the destructors of a class hierarchy,
102 as illustrated in the synopsis above. Each class in the hierarchy
103 has a DESTROY method that performs some class-specific action
104 and then redispatches the call up the hierarchy. As a result,
105 when an object of class D is destroyed, the destructors of I<all>
106 its parent classes are called (in depth-first, left-to-right order).
108 Another typical use of redispatch would be in C<AUTOLOAD>'ed methods.
109 If such a method determined that it was not able to handle a
110 particular call, it might choose to redispatch that call, in the
111 hope that some other C<AUTOLOAD> (above it, or to its left) might
114 Note that it is a fatal error for any method (including C<AUTOLOAD>)
115 to attempt to redispatch any method except itself. For example:
117 sub D::oops { print "oops!\n"; $_[0]->NEXT::other_method() }
122 Damian Conway (damian@conway.org)
124 =head1 BUGS AND IRRITATIONS
126 Because it's a module, not an integral part of the interpreter, NEXT.pm
127 has to guess where the surrounding call was found in the method
128 look-up sequence. In the presence of diamond inheritance patterns
129 it occasionally guesses wrong.
131 It's also too slow (despite caching).
133 Comment, suggestions, and patches welcome.
137 Copyright (c) 2000, Damian Conway. All Rights Reserved.
138 This module is free software. It may be used, redistributed
139 and/or modified under the terms of the Perl Artistic License
140 (see http://www.perl.com/perl/misc/Artistic.html)