Mailing List Archive

Here's another cute way to call your super.

package Base;

sub meth { print "Base\n" }

package Derived;

@ISA = Base;

sub meth {
my $self = shift;
print "Derived\n";
local *meth;
$self->meth;
}

package main;

Derived->meth;

Larry

: Which my mind isn't quite twisted enough to understand quite how it
: works :-). However, it bugs out in the case where a superclass also
: calls super:

Okay, your code gave me the clue for fixing mine. Try this one:

package EvenBaser;
sub meth { print "EvenBaser\n" }

package Base;
@ISA = EvenBaser;
sub meth {
my $self = shift;
print "Base\n";
local *meth;
$self->Base::meth;
}

package Derived;
@ISA = Base;

sub meth {
my $self = shift;
print "Derived\n";
local *meth;
$self->Derived::meth;
}

package main;

Base->meth;
Derived->meth;

: And also where the Derived class inherits the method (same bug I think
: in slightly different disguise):

This seems to work:

package Base;
sub meth { print "Base\n" }

package Derived;
@ISA = Base;

sub meth {
my $self = shift;
print "Derived\n";
local *meth;
$self->Derived::meth;
}

package Derived2;
@ISA = Derived;

package main;

Derived2->meth;

I believe you could use this trick in your generic super routine. You
don't have to search the classes yourself. Try this one on for size.

sub UNIVERSAL::callsuper {
my ($pkg) = caller;
my $self = shift;
my $meth = $pkg . '::' . shift;
local *$meth;
$self->$meth(@_);
}

package Base;
sub meth { print "Base\n" }

package Derived;
@ISA = Base;

sub meth {
my $self = shift;
print "Derived\n";
$self->callsuper("meth");
}

package Derived2;
@ISA = Derived;

package main;

Derived2->meth;

Larry

Here's something closer to your super class. It assumes $self is passed
as the first method argument though. I haven't tried the DB trick. I'm
still trying to decide if it's too tacky.

package super;
sub AUTOLOAD {
shift;
my $pkg = caller;
my $meth = $AUTOLOAD;
$meth =~ s/^super/$pkg/;
local *$meth;
shift->$meth(@_);
}

Larry

> Here's another cute way to call your super.
>
> package Base;
>
> sub meth { print "Base\n" }
>
> package Derived;
>
> @ISA = Base;
>
> sub meth {
> my $self = shift;
> print "Derived\n";
> local *meth;
> $self->meth;
> }
>
> package main;
>
> Derived->meth;
>
> Larry

Which my mind isn't quite twisted enough to understand quite how it
works :-). However, it bugs out in the case where a superclass also
calls super:

#!perl
package EvenBaser;
sub meth { print "EvenBaser\n" }

package Base;
@ISA = EvenBaser;
sub meth {
my $self = shift;
print "Base\n";
local *meth;
$self->meth;
}

package Derived;
@ISA = Base;

sub meth {
my $self = shift;
print "Derived\n";
local *meth;
$self->meth;
}

package main;

Base->meth; #works fine
Derived->meth; #loops eternally
__END__


And also where the Derived class inherits the method (same bug I think
in slightly different disguise):

package Base;
sub meth { print "Base\n" }

package Derived;
@ISA = Base;

sub meth {
my $self = shift;
print "Derived\n";
local *meth;
$self->meth;
}

package Derived2;
@ISA = Derived;

package main;

Derived2->meth; #loops eternally


Amusingly, mine had the same bug, but I know how to fix it - and here
is the fixed version, with the variables hopefully intact through my
mailer this time (example included - save everything after here in
file 'super.pm' and try 'perl -x super.pm'):

package super;
require Carp;

AUTOLOAD {
shift;
(my $method = $AUTOLOAD) =~ s/^.*:://;
package DB;
my(@ret) = caller(1);
package super;
my $self = $DB::args[0];
(my $class = $ret[3]) =~ s/::[^:]*$//;
my($ret,$superclass,$supermeth);
if (wantarray) {
foreach $superclass (@{$class . '::ISA'}) {
$supermeth = $superclass . '::' . $method;
eval {@ret = $self->$supermeth(@_)};
$@ || return @ret;
$@ =~ /^Can't locate object method/ || die $@;
}
} else {
foreach $superclass (@{$class . '::ISA'}) {
$supermeth = $superclass . '::' . $method;
eval {$ret = $self->$supermeth(@_)};
$@ || return $ret;
$@ =~ /^Can't locate object method/ || die $@;
}
}
Carp::croak("Can't locate object method \"$method\" via superclasses of package \"$class\"");
}

1;
__END__
#!perl
#Example of using 'super'.
require super;

package A;
sub dib {print "Hello from 'dib' in package A: @_\n"}
package B2;
sub dob {print "Hello from 'dob' in package B2: @_\n"}
package B;
@ISA = B2;
sub dob {
print "Hello from 'dob' in package B: @_\n";
my $self = shift;
super->dob(@_); # super of this method
}
package C;
@ISA = qw(A B);
sub dib {print "Hello from 'dib' in package C: @_\n"}
sub dob {
print "Hello from 'dob' in package C: @_\n";
my $self = shift;
super->dob(@_); # super of this method
$self->dib(@_);
super->dib(@_); # super of another method

super->non_existent(@_); # And one to produce an error
}

C->dob(25,'arg2');
__END__


-- Jack Shirazi, JackS@slc.com

In <9510110944.AA00804@maildrop.exnet.com>
On Wed, 11 Oct 95 10:44:19 BST
Jack Shirazi <JackS@slc.com> writes:
>
>
>And also where the Derived class inherits the method (same bug I think
>in slightly different disguise):
>
> package Base;
> sub meth { print "Base\n" }
>
> package Derived;
> @ISA = Base;
>
> sub meth {
> my $self = shift;
> print "Derived\n";
> local *meth;
> $self->meth;
> }
>
> package Derived2;
> @ISA = Derived;
>
> package main;
>
> Derived2->meth; #loops eternally
>
>
This case failing makes the scheme unusable - which is a pity, as neither
Jack's solution nor Tk's is tidy.

Tk has an automated scheme based on the ::Inherit::ISA trick from perlbot:

sub Inherit
{
my $w = shift;
my $method = shift;
my $what = (caller(1))[3];
my ($class) = $what =~ /^(.*)::[^:]+$/;
@{$class.'::Inherit::ISA'} = @{$class.'::ISA'} unless (defined @{$class.'::Inherit::ISA'});
$class .= '::Inherit::';
$class .= $method;
return $w->$class(@_);
}

sub InheritThis
{
my $w = shift;
my $what = (caller(1))[3];
my ($class,$method) = $what =~ /^(.*)::([^:]+)$/;
@{$class.'::Inherit::ISA'} = @{$class.'::ISA'} unless (defined @{$class.'::Inherit::ISA'});
$class .= '::Inherit::';
$class .= $method;
return $w->$class(@_);
}

I believe, in recent perls, return as in sub Inherit.* above handles
array/scalar context correctly.

Usage looks like:

$widget->Inherit('method');

sub method
{
my $self = shift;
$self->InheritThis(@_);
}

Tk uses above scheme to avoid folk having to reitterate @ISA in explcit
@Package::Inherit::ISA = @Package::ISA;
in every class, it also makes it easier to re-name a class.

Tk's AUTOLOAD is already heavily abused - one of things I would like
to 'super' *is* AUTOLOAD!

In <9510111556.AA24288@scalpel.netlabs.com>
On Wed, 11 Oct 95 08:56:34 -0700
Larry Wall <lwall@scalpel.netlabs.com> writes:

>I believe you could use this trick in your generic super routine. You
>don't have to search the classes yourself. Try this one on for size.
>
> sub UNIVERSAL::callsuper {
> my ($pkg) = caller;
> my $self = shift;
> my $meth = $pkg . '::' . shift;
> local *$meth;
> $self->$meth(@_);
> }
>

Looks promising - beats all that messing with Inherit::ISA,
can we expect this in UNIVERSAL in 5.002 ?

>> Here's something closer to your super class. It assumes $self
is passed
>> as the first method argument though. I haven't tried the DB
trick. I'm
>> still trying to decide if it's too tacky.
>>
>> package super;
>> sub AUTOLOAD {
>> shift;
>> my $pkg = caller;
>> my $meth = $AUTOLOAD;
>> $meth =~ s/^super/$pkg/;
>> local *$meth;
>> shift->$meth(@_);
>> }
>>
>> Larry
>
>Ah, lovely. But the AUTOLOAD doesn't seem to get the arguments
>unless you call the super with arguments, (i.e. super->meth
>and super->meth(@_) give different results).
>
>So we either leave it as is, documenting it as needing to
>be called as super->meth(@_), or we play around with DB
>to do something or other.

I do not understand your problem here. I wrote @ISA=..., so
I should know what that superclass does. And of course I have
to use the proper arguments (which may or may not be @_). Before
I started working intensivly with perl5, I programmed 5 years in
Objective-C, and I was really missing 'super' (especially in a
project that went live ago, where I use 40+ perl classes)
In may way of thinking super is a necessity for inheritance.

The only thing that bugs me in Larry's code above is that second
shift, either I am missing some magic here, or it is nonsense.

Gerd

> Here's something closer to your super class. It assumes $self is passed
> as the first method argument though. I haven't tried the DB trick. I'm
> still trying to decide if it's too tacky.
>
> package super;
> sub AUTOLOAD {
> shift;
> my $pkg = caller;
> my $meth = $AUTOLOAD;
> $meth =~ s/^super/$pkg/;
> local *$meth;
> shift->$meth(@_);
> }
>
> Larry

Ah, lovely. But the AUTOLOAD doesn't seem to get the arguments
unless you call the super with arguments, (i.e. super->meth
and super->meth(@_) give different results).

So we either leave it as is, documenting it as needing to
be called as super->meth(@_), or we play around with DB
to do something or other.


-- Jack Shirazi, JackS@slc.com

In <9510120229.AA03326@Homer.BITart.com>
On Wed, 11 Oct 95 21:29:28 -0500
<gerti@BITart.com> writes:
>>>
>>> package super;
>>> sub AUTOLOAD {
>>> shift;
>>> my $pkg = caller;
>>> my $meth = $AUTOLOAD;
>>> $meth =~ s/^super/$pkg/;
>>> local *$meth;
>>> shift->$meth(@_);
>>> }
>>>
>>> Larry
>
>The only thing that bugs me in Larry's code above is that second
>shift, either I am missing some magic here, or it is nonsense.
>

The calling sequence for above is I think:

super->method($object,...)

I don't like this Tk has :

$object->Inherit('method',...);

and

sub whatever
{
my $object = shift;
...
$object->InheritThis(,...); # call super's 'whatever'
}

I believe this can be implemented using Larry's trick.

>>> package super;
>>> sub AUTOLOAD {
>>> shift;
>>> my $pkg = caller;
>>> my $meth = $AUTOLOAD;
>>> $meth =~ s/^super/$pkg/;
>>> local *$meth;
>>> shift->$meth(@_);
>>> }
>>>
> The calling sequence for above is I think:
>
> super->method($object,...)
>
> I don't like this Tk has :
>
> $object->Inherit('method',...);
>
> and
>
> sub whatever
> {
> my $object = shift;
> ...
> $object->InheritThis(,...); # call super's 'whatever'
> }
>
> I believe this can be implemented using Larry's trick.

Well, if we're expressing preferences, then euhh, yuck!

Still, we could stick the lot in a 'super' package since
I guess your ones would be exported, allowing people
to choose whichever.


-- Jack Shirazi, JackS@slc.com

Gerd Knops writes:
>
> Larry wrote:
> > Here's something closer to your super class. It assumes $self is passed
> > as the first method argument though. I haven't tried the DB trick. I'm
> > still trying to decide if it's too tacky.
> >
> > package super;
> > sub AUTOLOAD {
> > shift;
> > my $pkg = caller;
> > my $meth = $AUTOLOAD;
> > $meth =~ s/^super/$pkg/;
> > local *$meth;
> > shift->$meth(@_);
> > }
> >
> > Larry
>
> I added the DB trick:
>
> package super;
> sub AUTOLOAD {
> shift;
> package DB;
> my(@ret) = caller(1);
> package super;
> my $pkg = caller;
> my $meth = $AUTOLOAD;
> $meth =~ s/^super/$pkg/;
> local *$meth;
> $DB::args[0]->$meth(@_);
> }
>
> Now it does what I want.
>
> Thanks to Jack and Larry!
>
> Gerd
>

Could you kindly explain what it does? I know that caller fills
@DB::args somehow, but why `package DB' above?

Btw, what is @DB::ARGS, and what is @DB::args on start?

Ilya

Larry wrote:
> Here's something closer to your super class. It assumes $self is passed
> as the first method argument though. I haven't tried the DB trick. I'm
> still trying to decide if it's too tacky.
>
> package super;
> sub AUTOLOAD {
> shift;
> my $pkg = caller;
> my $meth = $AUTOLOAD;
> $meth =~ s/^super/$pkg/;
> local *$meth;
> shift->$meth(@_);
> }
>
> Larry

I added the DB trick:

package super;
sub AUTOLOAD {
shift;
package DB;
my(@ret) = caller(1);
package super;
my $pkg = caller;
my $meth = $AUTOLOAD;
$meth =~ s/^super/$pkg/;
local *$meth;
$DB::args[0]->$meth(@_);
}

Now it does what I want.

Thanks to Jack and Larry!

Gerd

Gerd Knops writes:
>
> Larry wrote:
> > Here's something closer to your super class. It assumes $self is passed
> > as the first method argument though. I haven't tried the DB trick. I'm
> > still trying to decide if it's too tacky.
> >
> > package super;
> > sub AUTOLOAD {
> > shift;
> > my $pkg = caller;
> > my $meth = $AUTOLOAD;
> > $meth =~ s/^super/$pkg/;
> > local *$meth;
> > shift->$meth(@_);
> > }
> >
> > Larry
>
> I added the DB trick:
>
> package super;
> sub AUTOLOAD {
> shift;
> package DB;
> my(@ret) = caller(1);
> package super;
> my $pkg = caller;
> my $meth = $AUTOLOAD;
> $meth =~ s/^super/$pkg/;
> local *$meth;
> $DB::args[0]->$meth(@_);
> }
>
> Now it does what I want.
>
> Thanks to Jack and Larry!
>
> Gerd
>

Ilya asks:
> Could you kindly explain what it does? I know that caller fills
> @DB::args somehow, but why `package DB' above?
>
> Btw, what is @DB::ARGS, and what is @DB::args on start?

With Larry's solution, in order to call super you would have to say:

super->method($self,@_);

to call a superclass method. Which is fine, only that I have to keep
my Objective-C fans happy. It is to close to Objective-C, so they
would forget often that they have to put $self into the arguments.

Now they can do as they are easier to get used to:

super->method(@_);

The DB trick: The perlfunc man page says about 'caller':

Furthermore, when called from within the DB package,
caller returns more detailed information: it sets
sets the list variable @DB:args to be the arguments
with which that subroutine was invoked.

So, switching to the DB package allows me to get to '$self', a
trick that Jack came up with in this context.

Gerd