use strict;
use warnings;

package Car;

my %carByType;

sub new {
    my ($class, %opts) = @_;

    return bless \%opts, $class;
}


sub factory {
    my (%opts) = @_;

    die "Don't know how to make a new car"
        if !exists $opts{name} || !exists $carByType{$opts{name}};

    $carByType{$opts{name}}->new(%opts);
}


sub describe {
    my ($self) = @_;
    my ($make) = ref ($self) =~ m/^Car::(.*)/;

    print "$make $self->{name}\n";
}

sub REGISTER_TYPE {
    my ($type, $name) = @_;

    $carByType{$name} = $type;
}

package Car::BMW;

our @ISA = qw/Car/;

Car::BMW->REGISTER_TYPE('Z1');
Car::BMW->REGISTER_TYPE('Z3');

package main;

my $z1 = Car::factory(name => 'Z1');

$z1->describe();

##</code><code>##

BMW Z1