perl - 如何检测导出的潜艇覆盖？

Question

有下一个代码:

use strict;
use warnings;

use Devel::Peek;
use YAML;

my $s = {a=>'b'};
print Dump($s);

它打印 YAML 输出:

---
a: b

现在改变模块的顺序。

use strict;
use warnings;

use YAML;
use Devel::Peek;

my $s = {a=>'b'};
print Dump($s);

它打印:

SV = IV(0x7ff5d2829308) at 0x7ff5d2829318
  REFCNT = 1
  FLAGS = (PADMY,ROK)
  RV = 0x7ff5d2803438
  SV = PVHV(0x7ff5d2808d20) at 0x7ff5d2803438
    REFCNT = 1
    FLAGS = (SHAREKEYS)
    ARRAY = 0x7ff5d243acf0  (0:7, 1:1)
    hash quality = 100.0%
    KEYS = 1
    FILL = 1
    MAX = 7
    Elt "a" HASH = 0x274d838f
    SV = PV(0x7ff5d2804070) at 0x7ff5d2828a00
      REFCNT = 1
      FLAGS = (POK,IsCOW,pPOK)
      PV = 0x7ff5d240e2d0 "b"\0
      CUR = 1
      LEN = 16
      COW_REFCNT = 1
Use of uninitialized value in print at yy line 8.

两个模块都导出一个函数 Dump所以，最后的胜利。

我已启用 warnings ，但它没有警告我导出的函数重新定义(覆盖？)。是否可以检测并显示此类重新定义的警告？

Answer 1

最有趣的问题。我认为问题在于 Exporter.pm 没有启用警告。这是一组简单的文件，演示了您描述的行为:

下午:

package Foo;
use base 'Exporter';
our @EXPORT = qw(Baz);

sub Baz {
    print "Hello from Foo::Baz\n";
}

酒吧.pm:

package Bar;
use base 'Exporter';
our @EXPORT = qw(Baz);

sub Baz {
    print "Hi from Bar::Baz\n";
}

进口重新定义.pl:

use strict;
use warnings;

use Foo;
use Bar;
Baz();

sample 运行:

C:\Users\Lona\Desktop\pm>perl import-redefine.pl
Hi from Bar::Baz

反转 use声明，如下:

use strict;
use warnings;

use Bar;
use Foo;
Baz();

再次运行:

C:\Users\Lona\Desktop\pm>perl import-redefine.pl
Hello from Foo::Baz

我想出了以下解决方案，它重新定义了 Exporter.pm 的默认值 import方法:

BEGIN {
    require Exporter;                               # We'll need Exporter.pm loaded.
    my $old_import = \&Exporter::import;            # Save copy of original Exporter::import.

    no strict 'refs';                               # We'll be using some hacks that will
    no warnings 'redefine';                         # raise errors and warnings. Suppress those.

    *Exporter::import = sub {                       # Our enhancement of Exporter::import.
        use Carp;
        my $pkg = shift;
        my $callpkg = caller($Exporter::ExportLevel + 1);

        my @exports =  @_ > 0                       # Which subs to export?
                       ? @_                         # Those provided as 'use MODULE' arguments...                
                       : @{"$pkg\::EXPORT"}         # Or thosedefined in the module's @EXPORT?
        ;
        foreach my $sub (@exports) {                # For each of the exportees... 
            if (exists ${"$callpkg\::"}{$sub}) {    # ... check if it exists...
                carp "Subroutine $callpkg\::$sub redefined by import"; # and throw a warning if needed.
            }
        $old_import->($pkg, @_);                    # Call the original Exporter::import.
        }
    }
}

要使用它，但它在你的主脚本文件的某个地方，在 use MODULE 上面声明:

use strict;
use warnings;

BEGIN {
    require Exporter;                               # We'll need Exporter.pm loaded.
    my $old_import = \&Exporter::import;            # Save copy of original Exporter::import.

    no strict 'refs';                               # We'll be using some hacks that will
    no warnings 'redefine';                         # raise errors and warnings. Suppress those.

    *Exporter::import = sub {                       # Our enhancement of Exporter::import.
        use Carp;
        my $pkg = shift;
        my $callpkg = caller($Exporter::ExportLevel + 1);

        my @exports =  @_ > 0                       # Which subs to export?
                       ? @_                         # Those provided as 'use MODULE' arguments...                
                       : @{"$pkg\::EXPORT"}         # Or thosedefined in the module's @EXPORT?
        ;
        foreach my $sub (@exports) {                # For each of the exportees... 
            if (exists ${"$callpkg\::"}{$sub}) {    # ... check if it exists...
                carp "Subroutine $callpkg\::$sub redefined by import"; # and throw a warning if needed.
            }
        $old_import->($pkg, @_);                    # Call the original Exporter::import.
        }
    }
}

use Foo;
use Bar;
Baz();

并运行它:

C:\Users\Lona\Desktop\pm>perl import-redefine.pl

Subroutine main::Baz redefined by import at import-redefine.pl line 21.
        main::__ANON__("Bar") called at import-redefine.pl line 30
        main::BEGIN() called at import-redefine.pl line 30
        eval {...} called at import-redefine.pl line 30
Hi from Bar::Baz