Is __PACKAGE__->method() the best way...

[Mark Maunder]

Hi, I need some advice from someone who has cut their teeth on inheritance a
few times...

I'm using __PACKAGE__->method() to call a method that exists in a class
higher up the inheritance tree when $self in the current method is a blessed
object from a class lower down the inheritance tree (relative to the class
in which I'm doing the __PACKAGE__->method() call). The reason I'm calling
__PACKAGE__ is because I want $self in the called method to refer to the
caller rather than the object with exists lower down the heirarchy. I'm
probably not making much sense, so I've included a working example below.

I have an alternative solution too using bless, but both of these seem
really clumsy! Is there a standard way of doing this? I've included some
code below that works as is and demo's both ways of doing things. Plus some
benchmarking code which shows that both of these run at about the same
speed - but my concern is symantics and readability/usability rather than
performance.

~mark

#!/usr/bin/perl

####################################
package grandparent;
use vars qw { @ISA };
@ISA = qw();

#Switch this to 1 to use the 'bless' tmp object solution.
use constant ALTERNATIVE_SOLUTION => 0;
#Switch this to 1 (and make sure ALTERNATIVE_SOLUTION is 0) to see
# the problem with just using $self in parent classes when calling
# methods higher up the tree that expect the caller to be $self
use constant BUGON => 0;
use constant VERBOSE => 1;

#I've benchmarked 100,000 iterations and they're the same for the bless, or
__PACKAGE__ solution. Damn! I guess I could use either.
use constant BENCHMARK => 0;

{
        my %_attr_data = (
                _gpkey1 => 'value1',
                _gpkey2 => 'value2',
                );

        sub _standard_keys
        {
                keys %_attr_data;
        }
}


sub new
{
        my $class = shift;
        my %attribs = @_;
        my $self = bless {}, $class;

        my @std_keys = $self->_standard_keys();
        foreach my $key (@std_keys)
        {
                $self->{$key} = $attribs{$key} if(exists $attribs{$key});
        }
        return $self;
}

sub make_sql
{
        my $self = shift;

        #This is the problem, right here. If $self is an object of type 'baby'
        # (i.e. if the parent methods calle $self->make_sql()) then
        # baby::_standard_keys gets called instead of the parent _standard_keys()
        # using PACKAGE or bless solves this
        my @fields = $self->_standard_keys();


        map { $_ = substr($_, 1) } @fields; #strips off the leading '_'
        print "Fields used for SQL generation are:\n   " . join(', ', @fields) .
"\n" if($self->VERBOSE);
}


#######################################
package parent;
use vars qw { @ISA };
@ISA = qw( grandparent );

{
        my %_attr_data = (
                _prnkey1 => 'value1',
                _prnkey2 => 'value2',
                );

        sub _standard_keys
        {
                keys %_attr_data;
        }
}


sub save_thyself
{
        my $self = shift @_;
        foreach my $parent (@ISA)
        {
                my $anc_meth = $parent->can("save_thyself");
                $self->$anc_meth() if $anc_meth;
        }
        print "\n\nCalling make_sql in " . __PACKAGE__ . "\n" if($self->VERBOSE);

        if(ALTERNATIVE_SOLUTION)
        {
                my $tmp_obj = bless {};
                $tmp_obj->make_sql();
        } else
        {
                $self->BUGON ? $self->make_sql() : __PACKAGE__->make_sql();
        }
        #Execute sql to save object
}

#######################################
package child;
use vars qw{ @ISA };
@ISA = qw( parent );

{
        my %_attr_data = (
                _chldkey1 => 'value1',
                _chldkey2 => 'value2',
                );
        sub _standard_keys
        {
                keys %_attr_data;
        }
}

sub save_thyself
{
        my $self = shift @_;
        foreach my $parent (@ISA)
        {
                my $anc_meth = $parent->can("save_thyself");
                $self->$anc_meth() if $anc_meth;
        }
        print "\n\nCalling make_sql in " . __PACKAGE__ . "\n" if($self->VERBOSE);
        if(ALTERNATIVE_SOLUTION)
        {
                my $tmp_obj = bless {};
                $tmp_obj->make_sql();
        } else
        {
                $self->BUGON ? $self->make_sql() : __PACKAGE__->make_sql();
        }
        #Execute sql to save object
}

############################################
package baby;
use vars qw{ @ISA };
@ISA = qw{ child };

{
        my %_attr_data = (
                _babykey1 => 'value1',
                _babykey2 => 'value2',
                );
        sub _standard_keys
        {
                keys %_attr_data;
        }
}

sub save_thyself
{
        my $self = shift @_;

        foreach my $parent (@ISA)
        {
                my $anc_meth = $parent->can("save_thyself");
                $self->$anc_meth() if $anc_meth;
        }
        print "\n\nCalling make_sql in " . __PACKAGE__ . "\n" if($self->VERBOSE);
        if(ALTERNATIVE_SOLUTION)
        {
                my $tmp_obj = bless {};
                $tmp_obj->make_sql();
        } else
        {
                $self->BUGON ? $self->make_sql() : __PACKAGE__->make_sql();
        }
        #execute sql
}

#############################################
package main;
use Benchmark;
my $thang = baby->new();


if($thang->BENCHMARK)
{
        print "Benchmarking 100,000 iterations of save_thyself:\n";
        timethis( 100000, sub{$thang->save_thyself()}, 'save_thyself');
} else
{
        $thang->save_thyself();
}



-- 
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]