Perl:如何从基类导入子例程？

Question

我有一个名为Foo :: Base的基类,我需要继承它的方法,比如'new'并在范围中导入一些子例程名称:

package Foo::Base;

sub new { ... }

sub import {
    no strict 'refs';

    my $caller = caller;

    *{"${caller}::my_sub"} = sub { 1 };
}

1;

所以,我需要在我的第二个类Foo :: Child中使用这个基类:

use base 'Foo::Base';

...它适用于继承,但它不会在范围中导入"my_sub".我可以添加字符串

use Foo::Base;

对它而言它有所帮助,但我不想写这样的东西:

use base 'Foo::Base';
use Foo::Base;

这看起来很奇怪......对这个问题有什么建议吗？

Answer 1

人们可能想要做你正在做的事情有两个原因,两者都很糟糕.

首先是你试图从父类导入方法......出于某种原因.也许你误解了OO是如何工作的.你不需要这样做.只需将继承的方法作为方法调用,除非这些方法做得很古怪,否则它会正常工作.

更有可能的是这是一个混合使用模块,其中一些是方法,一些是导入函数.为此,你可以做...

use base 'Foo::Base';
use Foo::Base;

你正确地观察到它看起来很奇怪......因为它有点怪异.同时导出的类是混合习语,这将导致奇怪的使用模式.

最好的办法是重新设计类而不是导出函数,将函数拆分为自己的模块,或者使它们成为类方法.如果这些函数与该类没有多大关系,那么最好将它们分开.如果它们与该类有关,那么将它们作为类方法.

use base 'Foo::Base';

Foo::Base->some_function_that_used_to_be_exported;

这消除了接口不匹配,作为奖励,子类可以像任何其他方法一样覆盖类方法行为.

package Bar;

use base 'Foo::Base';

# override
sub some_function_that_used_to_be_exported {
    my($class, @args) = @_;

    ...do something extra maybe...

    $class->SUPER::some_function_that_used_to_be_exported(@args);

    ...and maybe something else...
}

如果您无法控制基类,您仍然可以通过编写将导出的函数转换为方法的子类来使界面变得清晰.

package SaneFoo;

use base 'Foo::Base';

# For each function exported by Foo::Base, create a wrapper class
# method which throws away the first argument (the class name) and
# calls the function.
for my $name (@Foo::Base::EXPORT, @Foo::Base::EXPORT_OK) {
    my $function = Foo::Base->can($name);
    *{$name} = sub {
        my $class = shift;
        return $function->(@_);
    };
}

Answer 2

当你写作时use base,你正在使用base模块的设施.并且你传递了你想成为你的基类的模块的参数.

在OO IS-A关系中,不需要导入.你用OO模式调用方法:$object_or_class->method_name( @args ).有时这意味着你不关心调用者是谁,如下:

sub inherited_util {
    my ( undef, @args ) = @_;
    ... 
}

要么

sub inherited2 { 
    shift;
    ...
}

但是,如果要使用基本模块中定义的实用程序并继承该模块中定义的类行为,那么这正是两个use语句所指示的内容.

但是,如果您希望在模块中使用两种不同类型的行为,则最好将实用程序类型拆分为自己的模块,并从两个模块中使用它.无论哪种方式,显性行为通常优于隐式行为.

但是,我之前使用过这种模式:

sub import { 
    shift;
    my ( $inherit_flag ) = @_;
    my $inherit 
        = lc( $inherit_flag ) ne 'inherit' ? 0
        : shift() && !!shift()             ? 1
        :                                    0
        ;
    if ( $inherit ) { 
        no strict 'refs';
        push @{caller().'::ISA'}, __PACKAGE__;
        ...
    }
    ...
}

这样,我用一个明确的用法捆绑进行一次调用.

use UtilityParent inherit => 1, qw<normal args>;