perl - 我怎样才能 Hook Perl 的使用/要求，以便我可以抛出异常？

Question

如果一个文件已经加载，是否有任何方法可以挂接到 use/require所以我可以抛出异常？在我即将发布的 nextgen::blacklist ，如果使用某些模块，我会尝试死。我正在使用 perldoc -f require 中提到的对象 Hook 方法。 :有三类钩子(Hook)对象，带有子引用的数组和子引用。这篇文章中的例子是 object-hook，你可以在 nextgen::blacklist 中找到我对 sub-ref hook 的尝试。 .

我想要的语法是这样的:
perl -Mnextgen -E"use NEXT"

package Foo;
use nextgen;
use NEXT;

理想情况下，它应该抛出这样的消息:

nextgen::blacklist violation with import attempt for: [ NEXT (NEXT.pm) ] try 'use mro' instead.

我已经尝试了很多不同的方法。

package Class;
use Data::Dumper;
use strict;
use warnings;

sub install {
  unshift @main::INC, bless {}, __PACKAGE__
    unless ref $main::INC[0] eq __PACKAGE__
  ;
}

sub reset_cache { undef %main::INC }

sub Class::INC {
  my ( $self, $pmfile ) = @_;
  warn Dumper [\%main::INC, $pmfile];
  #undef %INC;
} 

package main;
  BEGIN { Class->install; undef %main::INC }
  use strict;
  use strict;
  use strict;
  use strict;
  use warnings;
  use strict;
  use warnings;

好像 %INC仅在这些钩子(Hook)之后设置。我对任何可以让我抛出异常的东西都感兴趣。如果尝试加载/重新加载一个模块，尽管它的状态是其他不使用我的编译指示的模块的依赖项，我想死。

package Foo;
use NEXT;

package main;
use Foo; (which uses Next.pm);
use NEXT.pm; ## Throw exception

Answer 1

您可能希望将 coderef 放在开头的 @INC 上，如 perldoc -f require 中所述。 .从那里，您可以引发异常以防止某些模块被加载，或者什么都不做以让 require 继续其在其他 @INC 条目中查找模块的正常工作。

$ perl -E'BEGIN { unshift @INC, sub { die q{no NEXT} if pop eq q{NEXT.pm}; () }; }; use Carp; say q{success}'
success
$ perl -E'BEGIN { unshift @INC, sub { die q{no NEXT} if pop eq q{NEXT.pm}; () }; }; use NEXT; say q{success}'
no NEXT at -e line 1.
BEGIN failed--compilation aborted at -e line 1.

如果你希望这种行为是词法的，你应该使用 Perl 的提示哈希 %^H .处理它有点繁琐，所以我建议使用 Devel::Pragma ，它可以为您处理所有血腥的细节。

正如您所指出的， @INC对于已经加载的模块，不会执行钩子(Hook)。如果您还需要 Hook use或 require加载的模块，覆盖 CORE::GLOBAL::require会起作用，因为每次尝试加载模块时都会调用它。

$ perl -E'BEGIN { *CORE::GLOBAL::require = sub { warn @_ } } use NEXT; use NEXT;'
NEXT.pm at -e line 1
NEXT.pm at -e line 1.

另外，作为 NEXT 的维护者，我完全赞成永远阻止人们使用它。 :-)