如何有条件地从另一个模块导入函数并将它们导出到本地命名空间

How to conditionally import functions from another module and export them to the local namespace

假设我有一个名为 Local 的模块,它通过 %EXPORT_TAGS 接口导出一个子例程 subLocal

此模块与另一个名为 Remote 的模块密切相关,后者定义了 Local 的用户可能想要导入的子例程。

我想满足两个要求:

    仅当模块 Local 的用户正在导入 Remote 中定义的子例程时,
  1. 模块 Local 才应导入 Remote 中定义的子例程(通过显式命名导出或使用特定的导出标签)

  2. Remote 的子例程导入 Local 时,模块 Local 的用户应该能够引用该子例程,就好像它在他的本地名称空间(与引用 Local 中定义的子例程时的行为相同)。

我只为请求找到了一个(hacky)解决方案。 2 通过在符号 table 中添加一个条目,但是这个 总是 发生——不管 Local 的用户是否真的需要 Remote 中的子例程.根据 perldoc,这毫无意义 "pollutes" 命名空间。

那么我应该在编译或运行时的什么时候尝试从 Remote 导入子例程?我如何以它们出现在本地名称空间中的方式实际导入它们?

这是我目前的做法。模块 Local:

package Local;

use strict;
use warnings;

BEGIN
{
  require Exporter;

  our @ISA = qw| Exporter |;

  our @EXPORT_LOCAL  = qw| subLocal |; 
  our @EXPORT_REMOTE = qw| subRemote |;

  our @EXPORT_OK   = ( @EXPORT_LOCAL, @EXPORT_REMOTE );
  our %EXPORT_TAGS = 
    ( all => \@EXPORT_OK, local => \@EXPORT_LOCAL, remote => \@EXPORT_REMOTE );

  *subRemote  = \&Remote::subRemote; # <-- can I do this conditionally somewhere? 
                                     # <-- and is there a better way to put this function in the user's local namespace?
}

use Remote; # <-- can I do this conditionally somewhere?

sub subLocal { return "(local)" }

1;

和模块 Remote:

package Remote;

use strict;
use warnings;

BEGIN
{
  require Exporter;

  our @ISA = qw| Exporter |;

  our @EXPORT_REMOTE = qw| subRemote |;

  our @EXPORT_OK   = ( @EXPORT_REMOTE );
  our %EXPORT_TAGS = 
    ( all => \@EXPORT_OK, remote => \@EXPORT_REMOTE );
}

sub subRemote { return "(remote)" }

1;

为什么要将潜艇导入要求本地导出的本地潜艇?不妨将它们直接放入正确的模块而不是本地!

无论哪种方式,您将无法(仅)使用 Exporter。您可能可以使用现有的 Exporter 替代方案。否则,您需要自己编写 import.

Local.pm:

package Local;

use strict;
use warnings;

use Carp         qw( croak );
use Exporter     qw( );
use Import::Into qw( );
use Remote       qw( );

my @export_ok_local  = qw( subLocal );
my @export_ok_remote = qw( subRemote );
my @export_ok_all    = ( @export_ok_local, @export_ok_remote );

my %export_tags = (
   ':ALL'     => \@export_ok_all,
   ':DEFAULT' => [],
   ':local'   => \@export_ok_local,
   ':remote'  => \@export_ok_remote,
);

our @EXPORT_OK = @export_ok_local;

sub import {
   my $class = shift;
   my $target = caller;

   my @imports =
      map {
         !/^:/
            ? $_
            : !$export_tags{$_}
               ? croak("\"$_\" isn't a recognized tag")
               : @{ $export_tags{$_} }
      }
         @_;

   my %imports = map { $_ => 1 } @imports;

   my @local  = grep { $imports{$_} } @export_ok_local;
   my @remote = grep { $imports{$_} } @export_ok_remote;

   delete @imports{ @local, @remote };
   my @unknown = keys(%imports);
   croak("Not exported by ".__PACKAGE__.": @unknown\n") if @unknown;

   Remote->import::into($target, @remote);

   @_ = ( $class, @local );
   goto &Exporter::import;
}

sub subLocal { print("subLocal\n"); }

1;

Remote.pm:

package Remote;

use strict;
use warnings;

use Exporter qw( import );

our @EXPORT_OK = qw( subRemote );

sub subRemote { print("subRemote\n"); }

1;

测试:

$ perl -e'
    use Local qw( subLocal subRemote );
    subLocal();
    subRemote();
'
subLocal
subRemote

$ perl -e'
    use Local qw( :ALL );
    subLocal();
    subRemote();
'
subLocal
subRemote

只需导入要导出的所有内容就简单多了。

package Local;

use strict;
use warnings;

use Exporter qw( import );    

my ( @EXPORT_LOCAL, @EXPORT_REMOTE );
BEGIN {
  @EXPORT_LOCAL  = qw| subLocal |; 
  @EXPORT_REMOTE = qw| subRemote |;

  our @EXPORT_OK = ( @EXPORT_LOCAL, @EXPORT_REMOTE );

  our %EXPORT_TAGS = (
    ALL    => \@EXPORT_OK,
    local  => \@EXPORT_LOCAL,
    remote => \@EXPORT_REMOTE,
  );
}

use Remote @EXPORT_REMOTE;

sub subLocal { ... }

1;

我认为问题是:Local 的调用者可以在其导入列表中要求 subRemote,但如果没有,则符号不会被推入调用者的命名空间.

我还假设 Local 根本不应从 Remote 导入,除非 Local 的调用者在其导入列表中需要 Remote 的某些子项。

然后自己写sub import。调用者提供的列表是传递给 import 的参数,第一个参数是 __PACKAGE__(在本例中为 Local)。

然后在您的 import 中您可以检查是否需要 subRemote。如果是,require 定义它的包并将其子程序的全名推送到调用者的符号 table,否则不是。您可以建立并检查您可能需要的任何其他条件。

只有当 Local 的调用者需要来自 Remote.

的子时,Local 才加载 Remote

上述描述的示例

Local.pm

package Local;

use warnings;
use strict;
use Exporter qw();

our @EXPORT_OK = qw(subLocal subRemote);

sub import {
    my $class = shift;

    my $re = qr/^(?:subRemote|other)/;
    my @local_exports  = grep { !/$re/ } @_;
    my @remote_exports = grep {  /$re/ } @_;   # check both

    if (@remote_exports) {   
        no strict 'refs';
        require Remote;
        foreach my $export (@remote_exports) 
        {   
            my $to_caller = caller() . '::' . $export;

            *{ $to_caller } = \&{ 'Remote::' . $export };
        }   
    }   

    @_ = ($class, @local_exports);  # set up @_ for goto
    goto &Exporter::import;         # switch to Exporter::import
}

sub subLocal {  print "subLocal() in ", __PACKAGE__, "\n" }

1;

请求的 Remote 中的 subs 引用被写入调用者的符号 table。然后我们的 importExporter::import 交换,用于从 Local 导出其余符号。例如,对于 goto 的注释。遗漏了一些东西,首先是检查收到的进口清单。

mainRemote

没有惊喜

main.pl

use warnings;
use strict;
use Local qw(subLocal subRemote);

subLocal();
subRemote();

Remote.pm

package Remote;   
use warnings;
use strict;
use Exporter qw(import);

our @EXPORT_OK = qw(subRemote);

sub subRemote { print "subRemote() in ", __PACKAGE__, "\n" }

与输出

subLocal() in Local
subRemote() in Remote

这完成了所要求的,但它必须处理相当具体的细节。

老实说,我认为乱用 import 造成的混乱可能比名称空间污染更严重,如果您选择冲突的标识符,这只是一个问题与进口的

这是一个使用面向对象设计的示例,它根本不使用 import 并且命名空间污染为零。您甚至不必在主程序中说明您将使用哪些方法

Remote.pm

use 5.010;

package Remote;

sub new {
    my $class = shift;

    my $self = bless {}, $class;
}

sub subRemote {
    say "I am subRemote";
}

1;

Local.pm

use 5.010;

package Local;

use base 'Remote';

sub new {
  my $class = shift;

  my $self = $class->SUPER::new(@_);
}

sub subLocal {
    say "I am subLocal";
}

1;

main.pl

use 5.010;

use Local;

my $obj = Local->new;

$obj->subLocal;
$obj->subRemote;

输出

I am subLocal
I am subRemote