CBase *p;
p = new(CDerived);
p->virtual_function();
[download]

The C++ compiler and linker handle all the chores of setting up the vtable and dispatching function calls to the correct function definition. The system provides a built in layer of abstraction between the idea of the object and its implimentation. It occured to me that a proxy class might provide a similar abstraction for Perl. Continuing the previous posters use of dogs:

package Dog::Proxy;

use strict;
use Dog::Base;
use Dog::Cocker;
use Dog::CattleDog;

my %derived_classes = (
    cocker => 'Dog::Cocker',
    cattledog => 'Dog::CattleDog',
);

sub new {
    my $class = shift;
    die if ref $class;
    my $type = shift;
    die "Cant create Dog::Base without breed" unless $type;
    die "Type $type not registered" unless exists $derived_classes{$ty
+pe};
    my $class = $derived_classes{$type};
    return $class->new();
}

1;
[download]

The Dog::Proxy class holds all the information about the Dog hierarchy and all construction of objects deriving from Dog::Base take place here. The proxy has no methods or attributes and passes back a reference to the new Dog::Breed. I also disallowed the creation of a Dog::Base, but I suppose that in practice it might be preferable to be able to create a base class object as well.

package Dog::Base;

use strict;
my %basic_attr = (
    legs=>4,
    tail=>1,
    nose=>'wet',
);
sub new {
    my $class = shift;
    my $self = {} unless ref $class;
    $self = {
            base=>{%basic_attr},
            breed=>{},
    };
    return bless($self, $class);
}

1;
[download]

Dog::Base currently just initializes some attributes that supposedly will be common to all Dogs.

package Dog::Cocker;

use strict;
require Dog::Base;
use vars '@ISA';
@ISA = 'Dog::Base';

my %cocker_attr = (
    habits => 'barks at strangers',
    size => 'small',
    temperment => 'very loyal'
);

sub new {
    my $class = shift;
    my $self = Dog::Base->new() unless ref $class;
    $self->{breed} = {%cocker_attr};
    return bless($self, $class);
}

sub bark {
    my $self = shift;
    print "yarf\n";
}

sub wag_tail {
    my $self = shift;
    print "tail wagging\n";
}

1;

package Dog::CattleDog;

use strict;
require Dog::Base;
use vars '@ISA';
@ISA = 'Dog::Base';

my %cattledog_attr = (
    temperment => 'fiercley loyal',
    habits => 'leary of strangers',
    size => 'medium',
);

sub new {
    my $class = shift;
    my $self = Dog::Base->new() unless ref $class;
    $self->{breed} = {%cattledog_attr};
    return bless($self, $class);
}

sub bark {
    my $self = shift;
    print "shriek\n";
}

sub wag_tail {
    my $self = shift;
    print "tail over back\n";
}

1;
[download]

And the test code:

#!/usr/local/bin/perl -wT
# test.pl

use Dog::Proxy;
use Data::Dumper;
use strict;

my $cosette= Dog::Proxy->new('cattledog');
my $moose= Dog::Proxy->new('cocker');

print Dumper($cosette,$moose);

$cosette->bark; $cosette->wag_tail;
$moose->bark; $moose->wag_tail;
[download]

With the results:

$VAR1 = bless( {
                 'breed' => {
                              'habits' => 'barks at strangers',
                              'temperment' => 'very loyal',
                              'size' => 'small'
                            },
                 'base' => {
                             'legs' => 4,
                             'nose' => 'wet',
                             'tail' => 1
                           }
               }, 'Dog::Cocker' );
$VAR1 = bless( {
                 'breed' => {
                              'habits' => 'leary of strangers',
                              'temperment' => 'fiercley loyal',
                              'size' => 'medium'
                            },
                 'base' => {
                             'legs' => 4,
                             'nose' => 'wet',
                             'tail' => 1
                           }
               }, 'Dog::CattleDog' );
yarf
tail wagging
shriek
tail over back
[download]

A somewhat simple if not simplistic hierarchy. The proxy provides a benifit in that it abstracts out the concepts implicit in constructing an instance of a more abstract class, in this case a type of dog.

In my own development I have been attempting to go from the specific to the general in this way; by abstracting out the common elements of each type of thing, and by trying to notice what patterns tend to be used by each type. That is, what is the same about each type and what is different.