package Bubba;

use strict;
use warnings;

our %Defaults = (
  type => 'Gump',
);

sub new {
  my $this = shift;
  my $class = ref $this || $this;
  my %parms = @_;
  my $type = exists $parms{type} ? $parms{type} : $Defaults{type};
  delete $parms{type};
  if  ($class eq __PACKAGE__) {
    # if subclasses were in separate modules, we'd
    # dynamically load here
    $class .= "::$type";
    return $class->new(%parms);
  }
  my $self = {};
  bless $self, $class;
  # do stuff with parms as the subclass
  $self;
}

sub shout { print "Unobtainable shrimp. No subclass?\n" }

package Bubba::Gump;
use base 'Bubba';
sub shout { print "Boiled shrimp\n" }

package Bubba::Wump;
use base 'Bubba';
sub shout { print "Fried shrimp\n" }

1;

##</code><code>##

#!/usr/bin/perl -w

use strict;
use Bubba;

my $b = Bubba->new();
$b->shout;

my $g = Bubba->new(type => 'Wump');
$g->shout;

my $bg = Bubba::Gump->new();
$bg->shout;

my $bw = Bubba::Wump->new();
$bw->shout;

##</code><code>##

  # ./summon_bubba.pl
  Boiled shrimp
  Fried shrimp
  Boiled shrimp
  Fried shrimp