Changing the class of a Perl object to a subclass

Question

I have an OO design question. I've written the (pseudo)-pseudocode below to help illustrate my question. (I say "pseudo-pseudocode" because it's mostly correct, with only a few bits of nonsense...)

I'm using a Factory pattern to create objects of a class appropriate to the attributes I pass the Factory::new method. However, there are some attributes that I can only get after object creation which I want to then use to further subclass or "specialize" the type of object. I want to do this so I can use the same interface to all of the objects in main independent of the object class (I guess this is polymorphism).

First, the Factory class:

use strict;
use warnings;

package Vehicle::Factory;
sub new {
    my ( $class, $args ) = @_;
    if ( $args->{class} =~ /car/i ) {
        return Vehicle::Car->new($args);
    } else {
    # other possible subclasses based on attributes
    }
}
1;

Now for the associated classes:

package Vehicle;
sub new {
    my ( $class, $args ) = @_;
    bless $self, $class;
    $self->color( $args->color );
}

sub color {
    $_[1] ? $_[0]->{_color} = $_[1] : return $_[0]->{_color};
}

sub wheels {
    $_[1] ? $_[0]->{_wheels} = $_[1] : return $_[0]->{_wheels};
}

1;

And a subclass:

package Vehicle::Car;
use base qw( Vehicle );
sub get_fueltype {
    my ( $self, $args ) = @_;
    $self->fueltype = check_fuel_type;
}

sub fueltype {
    $_[1] ? $_[0]->{_fueltype} = $_[1] : return $_[0]->{_fueltype};
}

1;

Now for the "stage 2" subclasses. I can only create these when I know more about the object that's already been created...

package Vehicle::Car::Gas;
use base qw( Vehicle::Car );
sub fill_her_up {
    # Make sure it's Gas.
    # ...
}
1;

package Vehicle::Car::Diesel;
use base qw( Vehilce::Car );
sub fill_her_up {
    # Make sure it's Diesel.
    # ...
}
1;

package Vehicle::Car::Electric;
use base qw( Vehicle::Car );
sub fill_her_up {
    # Find a socket.
    # ...
}
1;

And the main body of code:

package main;

my $thing = Vehicle::Factory->new( color => "red", wheels => 4 );

$thing->get_fueltype;

# Somehow convert $thing to be an object of the appropriate subclass based on 
# the "fueltype" attribute

$thing->fill_her_up;

(I hope my horribly contrived example makes sense!)

Now, I'm not sure... Should I create a new object using instance data from $thing? Is there a way to subclass an object without destroying and recreating it?

Maybe I should I use the following approach, and re-use the Vehicle factory?

package Vehicle::Factory;

sub new {
    my ( $class, $args ) = @_;
    if ( $args->{class} =~ /car/i ) {
        return Vehicle::Car->new($args);
    }

    if ( $self->fueltype eq "gas" ) {
        return Vehicle::Car::Gas->new($args);
    }

    if ( $self->fueltype eq "diesel" ) {
        return Vehicle::Car::Diesel->new($args);
    }

    if ( $self->fueltype eq "electric" ) {
        return Vehicle::Car::Electric->new($args);
    }
}

At this point in my real code - unlike my example - there's alot of instance data to then pass to a new object. I think it could be a little ugly if I need to pass all data between old and new object explicitly.

In my real code, there may be hundreds / thousands of such objects fed from a config file, all requiring the same treatment but with some differences on how to do it. It's the difference between using Expect and SSH to get data from a remote device, or using SNMP. The second "level" of info is based on information I get when I query a remote device and get it's device type (among other things)...

Final point is: I'm almost complete writing the software, but a very "late" and important requirement has come up which necessitates this change. I really want to accomodate the late req as simply and elegantly as possible. I don't want to "hack" it in and change the interface in main.

Thanks in advance for any pointers.

Answer 1

Changing the type of an object is very easy in Perl, even after it has been created (easy enough to get yourself in big trouble).

$car = Vehicle::Factory->new( ... );
... stuff happens to $car ...

# Oh! Now I have decided that $car should be a Vehicle::RustBucket::Fiat
bless $car, 'Vehicle::RustBucket::Fiat';