Re: On Pseudohashes

[Damian Conway <damian@cs.monash.edu.au>]

Previously I wrote:

   > Tim writes:
   >    > What's needed, if you don't want to pre-declare all the
   >    > methods, is some way for autoload to say it 'failed'.
   > 
   > In fact, this capacity is useful (some might say "essential") for
   > *all* dynamically dispatched functions, not just those named
   > AUTOLOAD. One ought to be able to write:
   > 
   >         return $self->NEXT::m();
   >
   > where NEXT is analogous to SUPER, but resumes the current dispatch
   > search, rather than initiating a new dispatch.

And here's the implementation. Feedback most welcome.

Damian

-----------cut-----------cut-----------cut-----------cut-----------cut----------

# file: $perllib/Class/Redispatch.pm

package NEXT;

sub AUTOLOAD
{
        my $self = shift;
        my $caller = (caller(1))[3]; 
        my ($class,$method) = $caller =~ m{(.*)::(.*)}g;
        my $refclass = ref $self;
        if ($class ne $refclass and defined &{$refclass."::".$method}) {
                eval qq{ local *$caller; package $refclass;
                         \$self->SUPER::$method(\@_)
                                if \$self->can('$method'); }
        }
        else {
                eval qq{ local *$caller;
                         \$self->$method(\@_)
                                if \$self->can('$method'); }
        }
}

1;

__END__

=head1 NAME

Class::Redispatch - Provide a pseudo-class NEXT that allows method redispatch


=head1 SYNOPSIS

 use Class::Redispatch;
 
 package A;

 package B; @ISA = qw( A );
 sub AUTOLOAD  { print "B::AUTOLOAD\n"; $_[0]->NEXT::m() }
 sub DESTROY   { print "B::DESTROY\n";  $_[0]->NEXT::DESTROY() }
 
 package C;
 sub AUTOLOAD  { print "C::AUTOLOAD\n" }
 sub DESTROY   { print "C::DESTROY\n";  $_[0]->NEXT::DESTROY() }
 
 package D; @ISA = qw( B C E );
 sub AUTOLOAD  { print "D::AUTOLOAD\n" }
 sub DESTROY   { print "D::DESTROY\n";  $_[0]->NEXT::DESTROY() }
 sub q         { print "B::q\n"; $_[0]->NEXT::q() }
 
 package E;
 sub AUTOLOAD  { print "E::AUTOLOAD\n" }
 sub DESTROY   { print "E::DESTROY\n";  $_[0]->NEXT::DESTROY() }
 
 package main;
 
 my $obj = bless {}, "D";
 $obj->m();
 $obj->q();
 
 package D;
 $obj->SUPER::m();
 $obj->SUPER::q();


=head1 DESCRIPTION

Class::Redispatch adds a pseudoclass named C<NEXT> to any program
that uses it. If a method &m calls $self->NEXT::m(), the call to
m is redispatched as if the calling method had not been found.

In other words, a call to $self->NEXT::m() resumes the depth-first,
left-to-right search of parent classes that resulted in the original
call to &m.

A typical use would be in the destructors of a class hierarchy,
as illustrated in the synopsis above. Each class in the hierarchy
has a DESTROY method that performs some class-specific action
and then redispatches the call up the hierarchy. As a result,
when an object of class D is destroyed, the destructors of I<all>
its parent classes are called (in depth-first, left-to-right order:
D::DESTROY->B::DESTROY->C::DESTROY->E::DESTROY).

Another typical use of redispatch would be in AUTOLOADed methods.
If such a method determined that it was not able to handle a
particular call, it might choose to redispatch that call, in the
hope that some other AUTOLOAD (above it, or to its left) could
handle the call.


=head1 AUTHOR

Damian Conway (damian@conway.org)


=head1 BUGS AND IRRITATIONS

I can't find any way in pure Perl to distinguish between:

        package D;
        $obj->SUPER::m();

and

        package D;
        $obj->B::m();

Consequently, if &B::m redispatches calls:

        package B;
        sub m {
                my ($self, @args) = @_;
                # DO LOCAL STUFF, THEN...
                $self->NEXT::m(@args);
        }

then the redispatch mechanism can't tell whether or not to 
backtrack to D in order to find other methods to call. 
If the call was C<$obj-E<gt>SUPER::m()>, redispatch 
should backtrack to the other parents of D. But if the
call was C<$obj-E<gt>B::m()>, no backtracking should occur.

Since I can't find a way to distinguish these two cases, I currently
assume that all such calls are C<$obj-E<gt>SUPER::m()>. In other
words, any call via NEXT I<always> backtracks, even if it shouldn't.
Caveat scriptor!

Note that this limitation (as well as the speed penalty) would certainly
vanish if the NEXT pseudoclass functionality were folded into the core.

Comment, suggestions, and patches welcome.


=head1 COPYRIGHT

 Copyright (c) 2000, Damian Conway. All Rights Reserved.
 This module is free software. It may be used, redistributed
and/or modified under the terms of the Perl Artistic License
     (see http://www.perl.com/perl/misc/Artistic.html)

---

Follow-Ups from:

Gurusamy Sarathy <gsar@ActiveState.com>

References to:

Tim Bunce <Tim.Bunce@ig.co.uk>
Tom Christiansen <tchrist@chthon.perl.com>

---

[Date Prev][Date Next] [Thread Prev][Thread Next] [Date Index][Thread Index][Top&Search][Original]

---