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

时间:2017-05-01 18:03:05

标签: perl perl-module perl-exporter

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

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

我希望有两个要求:

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

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

  3. 我只找到了(hacky)req的解决方案。 2通过在符号表中添加条目,但始终发生 - 无论Remote的用户是否确实需要Remote中的子例程。根据perldoc,这毫无意义地污染了#34;命名空间。

    那么在编译或运行时期间我应该尝试从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;

    {{1}}

3 个答案:

答案 0 :(得分:2)

为什么要将sub导入Local要求Local导出的Sub?也可以将它们直接放入正确的模块而不是Local!

无论哪种方式,您都无法使用(仅仅)出口商。您可以使用现有的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;

答案 1 :(得分:2)

老实说,我认为通过弄乱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

答案 2 :(得分:1)

我提出的问题是:Local的调用者可以在其导入列表中需要subRemote,但如果没有,则符号不会被推入调用者的名称空间。< / p>

我还假设Local根本不应从Remote导入,除非Local的来电者在其导入列表中需要一些Remote的潜艇。

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

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

这种方式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的引用被写入调用者的符号表。然后我们的importExporter::import交换,用于从Local导出其余符号。有关goto see this的说明,例如。省略了一些事情,首先检查收到的导入列表。

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获得可靠且完整的解决方案,请参阅answer by ikegami,并使用(基本)继承answer by Borodin进行干净的方法。