将 Perl 对象的类更改为子类

Question

我有一个面向对象设计的问题。我编写了下面的（伪）伪代码来帮助说明我的问题。 （我说“伪伪代码”是因为它基本上是正确的，只有一些废话......）

我使用工厂模式来创建适合我传递给 Factory:: 的属性的类的对象新方法。但是，有一些属性只能在对象创建后获得，然后我想用它们来进一步子类化或“专门化”对象的类型。我想这样做，这样我就可以对 main 中的所有对象使用相同的接口，而与对象类无关（我猜这是多态性）。

首先，工厂类：

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;

现在介绍相关类：

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;

和子类：

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;

现在介绍“第 2 阶段”子类。只有当我更多地了解已经创建的对象时，我才能创建这些......

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;

以及代码的主体：（

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;

我希望我的可怕的设计示例有意义！）

现在，我不确定......我应该创建使用来自 $thing 的实例数据的新对象？ 有没有办法在不破坏和重新创建对象的情况下子类化对象？

也许我应该使用以下方法，并重新使用车辆工厂？

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);
    }
}

此时，在我的实际代码中（与我的示例不同），有大量实例数据要传递给新对象。我认为如果我需要显式地在新旧对象之间传递所有数据，这可能会有点难看。

在我的真实代码中，可能有数百/数千个从配置文件提供的此类对象，所有这些对象都需要相同的处理，但在如何处理方面存在一些差异。这是使用 Expect 和 SSH 从远程设备获取数据与使用 SNMP 之间的区别。第二个“级别”信息基于我查询远程设备并获取其设备类型（除其他外）时获得的信息......

最后一点是：我几乎完成了软件的编写，但是非常“迟到” ”并且出现了重要的要求，使得这一改变成为必要。我真的想尽可能简单而优雅地满足迟来的要求。我不想“破解”它并更改 main 中的界面。

预先感谢您的任何指点。

Answer 1

在 Perl 中更改对象的类型非常容易，即使在创建对象之后也是如此（容易给自己带来大麻烦）。

$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 2

感觉就像您想要创建一个单独的继承层次结构并委托给原始类的继承层次结构。
因此，您的 car.move 方法委托给 propulsionmechanism.burnfuel 方法，并且 propulsionmechanism 可以是电力、柴油或天然气。
基本上，更喜欢多态委托到不同的层次结构，而不是尝试扩展相同的层次结构。

Answer 3

Mob 是对的，但我为这样的事情制作了轻量级的“接口”类。例如，我可以将受体类定义为“Reclassable”，并且所有源自 Reclassable 的项目都支持 is_complete_candidate 检查。甚至是 cast 或 as 方法。

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]; }

您可以在 _cast 方法中进行验证。接收者可以决定选角时要鲁莽的程度。

然后，您在类 _cast 方法中进行健全性检查。

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