Изменение класса объекта Perl на подкласс - PullRequest
4 голосов
/ 16 ноября 2011

У меня есть вопрос дизайна ОО. Я написал (псевдо) -псевдокод ниже, чтобы проиллюстрировать мой вопрос. (Я говорю «псевдопсевдокод», потому что он в основном правильный, только с несколькими частями глупости ...)

Я использую шаблон Фабрики для создания объектов класса, соответствующего атрибутам, которым я передаю метод 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;

Теперь для связанных классов:

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.

Заранее спасибо за любые указатели.

Ответы [ 3 ]

9 голосов
/ 16 ноября 2011

Изменить тип объекта в 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';
7 голосов
/ 16 ноября 2011

Моб - это правильно, но я делаю легкие "интерфейсные" классы для подобных вещей.Например, я мог бы определить класс рецептора как «Переклассифицируемый», и все элементы, которые происходят от 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 метод.

7 голосов
/ 16 ноября 2011

Такое ощущение, что вы хотите создать отдельную иерархию наследования и делегировать ее из исходного класса.Таким образом, ваш метод car.move делегируется методу propulsionmechanism.burnfuel, а механизм propulsionmechanism может быть электрическим, дизельным или газовым.По сути, предпочитайте полиморфное делегирование другой иерархии, а не пытайтесь расширять ту же иерархию.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...