将Perl对象的类更改为子类

我有一个OO设计问题。我在下面编写了（伪）伪代码来帮助说明我的问题。（我之所以说“伪伪代码”，是因为它基本上是正确的，只有一些无意义的东西……）

我正在使用工厂模式创建一个类的对象，该类与我通过

Factory:：new

方法传递的属性相匹配。然而，有一些属性只有在对象创建之后才能获得，我想用它们来进一步子类化或“专门化”对象类型。我想这样做，这样我就可以对

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

中的界面

---

提前感谢您的指点。

感觉您想要创建一个单独的继承层次结构，并从原始类中委托给它。 因此，您的car.move方法将委托给推进机构。burnfuel方法和推进机构可以是电动的、柴油的或汽油的。

---

基本上，我们更喜欢将多态委托给不同的层次结构，而不是尝试扩展相同的层次结构

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

---

Mob是对的，但我为类似这样的事情创建了轻量级的“接口”类。例如，我可以将receptor类定义为“Reclassable”，并且从

Reclassable

派生的所有项都支持

is\u complete\u 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]; }

您可以在

\u cast

方法中进行验证。接收类可以决定它想在演员方面有多鲁莽

然后在class

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

---

这是一个有趣的评论，我理解你的观点。我认为在我的例子中，我已经完成了90%的代码，另一个答案（对象的祝福）可能就是我要走的路。如果我可能会不必要地挑逗，这对于那些想在计算机科学课上获得A的人来说是正确的答案。我的答案是针对那些想使用Perl来完成工作的人。（Axeman的回答指出了一个实际的中间立场）。让我们都同意，频谱两端（和中间）的存在是为什么stackoverflow是一个如此伟大的地方的一个很好的例子…；-）@暴徒们，既然你们决定不必要地挑衅，让我被激怒，开始我的宠物咆哮吧。为什么，哦，为什么，人们坚持不必要地使用继承——更喜欢委托而不是委托，未来的代码维护者（可能是几个月后的你）会更少地诅咒你。在CS类中会得到一个A。Perl是弱类型的，与其他语言相比，它具有更多用于继承和进行子例程/方法调用的表达模型。当然是TMTOWTDI，但委派是Perl没有的问题的解决方案。这听起来正是我需要的。非常感谢！答案被接受。那么，你会在工厂法中加入“再祝福”吗？@wawawa-这取决于你。如果你在给工厂打电话的过程中得到了不完整的信息，你可能会想在事后重新进行祝福。今天的“完成任务”是指明天的发布日期被推迟，对违反公共健康和安全的行为被否决。还有，我被不必要的激怒了。我真的很喜欢这样。。。谢谢你！可惜我不能有两个“选择的答案”

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