Perl 如何检测导出的SUB覆盖？

具有下一个代码：

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

，因此最后一个模块获胜

---

我已经启用了

警告

，但它没有就导出的函数重新定义（覆盖？）向我发出警告。可以检测并显示此类重新定义的警告？

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

下午六时

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

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

下午六时三十分

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

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

import-redefine.pl：

use strict;
use warnings;

use Foo;
use Bar;
Baz();

样本运行：

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

---

哇-很好的详细答案。老实说，希望在一些更容易的事情上，比如

使用warnins“exported_functions”或soo，但这似乎不是一件容易的事情。非常感谢。