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没有启用警告。这是一组简单的文件，用于演示您描述的行为：

Foo.pm：

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

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

Bar.pm：

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＆gt; 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

如何检测导出的子覆盖？

1 个答案: