#!/usr/bin/perl use strict; use warnings; use Animal; my $dog = Animal->new(); $dog->type("Dog"); my $cat = Animal->new(); $cat->type("Cat"); print $dog->speak; print $cat->speak; ------------------------------------------------------------------- package Animal; use Cat; use Dog; @ISA = qw(Cat Dog); use strict; sub new { my $proto = shift; my $class = ref($proto) || $proto; my $self = {}; $self->{TYPE} = undef; bless ($self, $class); return $self; } sub type { my $self = shift; if (@_) { $self->{TYPE} = shift } return $self->{TYPE}; } sub speak { my $self = shift; my $type = $self->{TYPE}; $self->$type::talk; } 1; ------------------------------------------------------------------- package Cat; use strict; sub speak { print "meow...\n"; } 1; ------------------------------------------------------------------- package Dog; use strict; sub speak { print "woof...\n"; } 1;