如何挂钩Perl的use / require以便我可以抛出异常？

Question

如果文件已经加载，那么无论如何都要挂钩use/require所以我可以抛出异常？在即将到来的nextgen::blacklist中，如果使用某些模块，我会试图死亡。我正在使用perldoc -f require中提到的object-hook方法：有三个类似的钩子对象，带有subref的数组和 subref < / em>的。这篇文章中的例子是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仅在这些挂钩后设置。我对任何可以让我抛出异常的事情感兴趣。如果尝试加载/重新加载模块，将其状态作为不使用my pragma的其他模块的依赖项，我想死。

package Foo;
use NEXT;

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

Answer 1

您可能希望将coderef放在@INC的开头，如perldoc -f 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的提示hash %^H。处理这个有点繁琐，所以我建议使用Devel::Pragma，它可以为你处理所有的血腥细节。

正如您所指出的，对于已经加载的模块，不会执行@INC挂钩。如果您还需要挂钩已加载模块的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的维护者，我完全赞成永远禁止人们使用它。 ： - ）