将Perl对象的类更改为子类

waw*_*awa 4 oop perl object

我有一个OO设计问题.我在下面写了(伪)-pseudocode来帮助说明我的问题.(我说"伪伪代码",因为它大部分是正确的,只有几点废话...)

我正在使用Factory模式来创建适合于我传递Factory::new方法的属性的类的对象.但是,有一些属性我只能在创建对象后获得,然后我想用它来进一步子类化或"特化"对象的类型.我想这样做,所以我可以使用相同的接口来main独立于对象类的所有对象(我猜这是polymorphism).

首先,工厂类:

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;
Run Code Online (Sandbox Code Playgroud)

现在为关联的类:

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;
Run Code Online (Sandbox Code Playgroud)

还有一个子类:

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;
Run Code Online (Sandbox Code Playgroud)

现在为"阶段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;
Run Code Online (Sandbox Code Playgroud)

而代码的主体:

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;
Run Code Online (Sandbox Code Playgroud)

(我希望我的可怕人为的例子有意义!)

现在,我不确定......我应该使用实例数据创建一个新对象$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);
    }
}
Run Code Online (Sandbox Code Playgroud)

在我的真实代码中 - 不像我的例子 - 然后有很多实例数据传递给一个新对象.如果我需要明确地传递旧对象和新对象之间的所有数据,我认为这可能有点难看.

在我的真实代码中,可能有数百/数千个这样的对象从配置文件中提供,所有这些都需要相同的处理,但在如何处理方面存在一些差异.使用Expect和SSH从远程设备或使用SNMP获取数据之间的区别.信息的第二个"级别"基于我在查询远程设备并获取其设备类型(以及其他内容)时获得的信息...

最后一点是:我几乎完全编写了软件,但是出现了一个非常"迟到"的重要要求,这需要进行这种改变.我真的希望尽可能简单而优雅地适应最新的需求.我不想"入侵"它并更改界面main.

提前感谢任何指针.

mob*_*mob 9

在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';
Run Code Online (Sandbox Code Playgroud)


Roh*_*ith 7

感觉就像你想要创建一个单独的继承层次结构并从原始类委托给它.所以你的car.move方法代表推进机制.燃料方法和推进机制可以是电动,柴油或天然气.基本上,更喜欢多态委托到不同的层次结构,而不是尝试扩展相同的层次结构.


Axe*_*man 7

Mob是对的,但我为这样的事情制作了轻量级的"接口"类.例如,我可能将受体类定义为"可重新定义",并且所有下降的项目都Reclassable支持is_complete_candidate检查.甚至castas方法.

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]; }
Run Code Online (Sandbox Code Playgroud)

您可以在_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;
}
Run Code Online (Sandbox Code Playgroud)

  • 我真的很喜欢这个......谢谢!惭愧我不能有两个"选择答案" (2认同)