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

Mob is right, but I make lightweight "interface" classes for things like this. For example, I might define the receptor class as "Reclassable" and all items that descend from Reclassable support a is_complete_candidate check. Or even a cast or as method.

package Reclassable;
sub _cast { Carp::croak ref( $_[1] ) . '::_cast unimplemented!'  }

sub cast { 
    my ( $self, $inst, $newclass ) = @_;
    $newclass = $self if $self ne __PACKAGE__;
    return bless( $inst, $newclass ) if $inst->isa( $newclass );
    return $newclass->_cast( $_[1] ) if $newclass->isa( __PACKAGE__ );
    return;
}

package AutoReclass;
use parent 'Reclassable';
sub _cast { bless $_[1], $_[0]; }

You can do your verification in the _cast method. And the receiving class can decide how reckless it wants to be with casting.

Then you do your sanity checks in the class _cast method.

sub _cast { 
    my ( $cls, $cand ) = @_;
    return unless (   $cand->{walks_like} eq 'duck'
                  and $cand->{talks_like} eq 'duck'
                  and $cand->{sound}      eq 'quack'
                  );
    $cand->{covering} = 'down' unless $cand->{covering} eq 'down';
    $cand->{initialized} ||= 1;
    return bless $cand, $cls;
}

Answer 2

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';

Answer 3

Feels like you want to create a separate inheritance hierarchy and delegate to that from the original class. So your car.move method delegates to a propulsionmechanism.burnfuel method and propulsionmechanism can be electric, diesel or gas. Basically, prefer polymorphic delegation to a different hierarchy, instead of trying to extend the same hierarchy.