How can I hook into Perl's use/require so I ca

问题:

If a file is already loaded, is there anyway to hook into the use/require so I can throw an exception? In my upcoming nextgen::blacklist, I'm trying to die if certain modules are used. I'm using the object-hook method as mentioned in perldoc -f require: there are three-like hooks object, array with subref, and subref. The example in this post is the object-hook, you can find my attempt of the sub-ref hook in nextgen::blacklist.

The syntax I'm desiring is something like:

perl -Mnextgen -E"use NEXT"

package Foo;
use nextgen;
use NEXT;

Ideally it is supposed to throw a message like this:

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

I've tried this a bunch of different ways.

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;

It seems as if %INC is only set after these hooks. I'm interested in anything that will allow me to throw an exception. If an attempt is made to load/reload a module dispite the status of it as a dependency of other modules that don't use my pragma, I want to die.

package Foo;
use NEXT;

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

回答1:

You probably want to put a coderef onto the beginning @INC, as described in perldoc -f require. From there, you can raise exceptions to prevent certain modules from being loaded, or do nothing to let require carry on with its normal job of looking up the module in the other @INC entries.

$ 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.

If you want that behaviour to be lexical, you should make use of Perl's hints hash %^H. Dealing with that is a little fiddly, so I'd recommend using Devel::Pragma, which can take care of all the gory details for you.

As you pointed out, the @INC hooks won't be executed for a module that's already loaded. If you also need to hook into the use or require of a loaded module, overriding CORE::GLOBAL::require would work, as it is called for every attempt to load a module.

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

Also, as the maintainer of NEXT, I completely approve of preventing people from using it, at all, ever. :-)