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

Question

如果一个文件已经加载了,无论如何都要挂钩,use/require所以我可以抛出一个异常？在我即将到来的时候nextgen::blacklist,如果使用某些模块,我会试图死亡.我正在使用如下所述的object-hook方法perldoc -f require:有三个类似钩子的对象,带有subref的数组和subref.这篇文章中的例子是object-hook,你可以找到我对sub-ref hook的尝试nextgen::blacklist.

我想要的语法是这样的:

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只是在这些钩子之后设置.我对任何可以让我抛出异常的事情感兴趣.如果尝试加载/重新加载模块,将其状态作为不使用我的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的提示哈希%^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的维护者,我完全赞成防止人们使用它.:-)