package B;

sub new {
	my $class = shift;	# ignore
	my $type = shift;
	if ($type == 1) {
		return D1->new(@_);
	} elsif ($type == 2) {
		return D2->new(@_);
	} else {
		return undef;
	}	
}

# more as appropriate

package D1;

@D1::ISA = qw( B );

sub new {
	# paranoia check
	# you may not want this and I haven't tested it anyway
	return unless caller eq 'B';
	# more as appropriate
}

package D2;

@D2::ISA = qw( B );

sub new {
	# you may not want this and I haven't tested it anyway
	return unless caller eq 'B';
}

##</code><code>##

package B;

my @models;	# factory model, get it?

sub add {
	my $self = shift;
	my $child_coderef = shift;
	push @models, $child_coderef;
}

sub new {
	my $class = shift;	# ignore
	my $type = shift;
	return unless $type;
	my $child_coderef = @models[$type - 1];
	return unless defined &$child_coderef;
	return $child_coderef->(@_);
}

package D3;

@D3::ISA = qw( B );
use B;	# gotta be done here

B->add(\&new);

sub new {
	# etc
}