从派生类对象返回基类对象

Question

我知道当我想将此机制应用于派生类的 Perl 对象时，Perl 不是静态类型的：

假设我有一个基类B 和一个继承自B 的派生类D。 我还有一个对象$obj，它包含一个D 对象。 函数 Bf() 需要 B 类型的参数。

显然（根据多态性规则）我可以像Bf($obj) 一样将$obj 传递给Bf()，但与静态类型语言不同的是Bf() 将看到整个D 对象（而不仅仅是B 的元素）。

在 Perl 中是否有一个（相当干净和简单的）解决方案来解决这个问题？解决方案应该“隐藏”B 在Bf() 中的D 中没有的属性（和方法），而不是限制对原始B（实际上是D）的修改。

仅限成人程序员（2020 年 3 月 6 日添加）

好的，人们想要更具体的描述。 不幸的是（正如所指出的）原始程序非常复杂，并且使用类似反射的机制来自动生成 getter、setter 和 formatter，我真的不能在这里给出一个最小的工作示例，因为它会不是最小的。

首先我有一个类MessageHandler 处理消息（不足为奇！）。 然后我有一个函数log_message($$$)，它期望（以及其他）MessageHandler 对象作为第一个参数。

然后我就有了这个类的层次结构（实际上它要复杂得多）：

MessageHandler
ControlMessageHandler (ISA: MessageHandler)
ControlMessageResponseHandler (ISA: ControlMessageHandler)

现在如果log_message 想要MessageHandler，我可以传递ControlMessageResponseHandler，因为它符合MessageHandler。 但是这样做会将ControlMessageResponseHandler 的所有属性暴露给log_message，而这些属性在MessageHandler 中是不存在的。

危险在于log_message 可能（错误地）访问ControlMessageResponseHandler 的属性，该属性在MessageHandler 中不存在。为了防止错误，我想防止这种情况发生，或者至少得到一些警告（就像我会使用静态类型的语言，如 Eiffel）。

里面的脏细节

以防万一，我将概述我的数组对象是如何构建的（一个工作示例需要大量额外的代码）：

首先数组索引是这样自动分配的：

use constant I_VERBOSITY    => IS_NEXT->(); # verbosity level
use constant I_TAG          => IS_NEXT->(); # additional tag
use constant I_TAG_STACK    => IS_NEXT->(); # tag stack
use constant I_MSG_DEBUG    => IS_NEXT->(); # handler for debug messages
...
use constant I_LAST         => IS_LAST->(); # last index (must be last)

I_LAST 是继承所必需的。 属性定义如下：

use constant ATTRIBUTES => (
    ['verbosity', I_VERBOSITY, undef],
    ['tag', I_TAG, \&Class::_format_string],
    ['tag_stack', I_TAG_STACK, undef],
    ['msg_debug', I_MSG_DEBUG, \&Class::_format_code],
...
);

定义包含如何格式化每个属性的提示。 此信息用于设置格式化程序以格式化每个属性，如下所示：

use constant FORMATTERS =>
    (map { Class::_attribute_string($_->[0], $_->[1], undef, $_->[2]) }
     ATTRIBUTES);           # attribute formatters

Getter 和 setter 自动定义如下：

BEGIN {
    foreach (ATTRIBUTES) {
    Class::_assign_gs_ai(__PACKAGE__, $_->[0], $_->[1]);
    }
}

构造函数将使用以下行：

my $self = [];

$#$self = I_LAST;
$self->[I_VERBOSITY] = $verbosity;
...

最后我的对象打印例程是这样的：

sub as_string($)
{
    my $self = shift;
    my $a_sep = ', ';

    return join($a_sep, map { $_->($self, $a_sep) } FORMATTERS);
}

通过继承看起来像这样：

sub as_string($)
{
    my $self = shift;
    my $a_sep = ', ';

    return join($a_sep, $self->SUPER::as_string(),
        map { $_->($self, $a_sep) } FORMATTERS);
}

Answer 1

我不确定你的问题是什么，尽管我认为你花了很长时间说“我有一个需要 B 对象的函数，我想将 D 对象传递给它。”

如果您只想要某种确切类型的对象，请不要接受其他任何内容：

use Carp qw(croak);
sub Bf {
    croak "Bad object! I only like B" unless ref $_[0] eq 'B';
    ...
    }

但是，这是个坏主意。派生类应该和基类一样好。干净的解决方案是不关心你得到什么类型。

sub Bf {
    croak "Bad object! Doesn't respond to foo!" unless $_[0]->can('foo');
    ...
    }

既然这个Bf 方法适用于基类，为什么它会在一些它不知道的派生类中寻找一些东西？如果派生类改变了接口并且不再像它的父类一样，那么它可能不适合继承。有很多这样的问题可以通过不同的架构来解决。

我认为您必须提出一个派生类不起作用的具体示例。

Answer 2

听起来出于某种原因，您需要D 对象的行为类似于B 对象，但同时不类似于D 对象。正如现有答案和 cmets 所表明的那样，在需要基类的地方使用子类是很常见的，大多数算法不应该关心您实际传递的是D 还是B。我能想到的唯一原因是 D 以不兼容的方式覆盖（重新定义）某些方法，而您需要 B 中的方法。

package Dog;
sub new {
  my ($class, %args) = @_;
  return bless \%args, $class;
}
sub bark { print "Bark!\n"; }

package Dingo;
use parent 'Dog';
sub bark { print "...\n"; }

package main;
my $dingo = Dingo->new;
$dingo->bark; # "..."

（注意，为了简洁起见，我省略了推荐的 use strict; 和 use warnings;，它们应该在所有包中使用）

通过阅读perldoc perlootut 和perldoc perlobj，您可能会意识到Perl 中的对象只是某种blessed 引用；在上面的示例中，我们使用哈希引用。如果您试图获取仅存在于B 中的“属性”，我认为您将不得不编写某种翻译方法。但是，如果您关心B 中存在的方法，您只需将bless 重新添加到父类中即可。

my $dingo = Dingo->new;
$dingo->bark; # "..."
bless $dingo, "Dog";
$dingo->bark; # "Bark!"

请注意，bless 不会返回新的引用，而是就地修改该引用；如果您希望它再次表现得像 Dingo，您必须返回 bless。

也许你可以更方便地定义一个方法来为你创建一个副本并将它祝福到适当的类中：

package Dog;
sub as_dog {
  my ($self) = @_;

  # The {} below create a shallow copy, i.e., a new reference
  return bless { %{$self} }, __PACKAGE__;
}

#...
package main;
my $dingo = Dingo->new;
$dingo->bark; # ...
$dingo->as_dog->bark; # Bark!
$dingo->bark; # ...

Answer 3

虽然似乎没有完美的解决方案，但临时“重新祝福”对象似乎非常接近要求：

sub Bf($) # expects a "B" object (or descendant of "B" (like "D"))
{
    my $B = shift;
    my $type = ref($B);  # save original type

    die "unexpected type $type" unless ($B->isa('B'));
    bless $B, 'B';       # restrict to "B"'s features
    $B->whatever(...);
    #...
    bless $B, $type;     # restore original type
}