我怎样才能挂钩 Perl 的 use/require 以便抛出异常?

发布于 2024-09-26 02:50:11 字数 1516 浏览 3 评论 0原文

如果文件已经加载,是否有办法挂钩 use/require 以便我可以抛出异常?在我即将推出的 nextgen::blacklist< /a>,如果使用某些模块,我会想死。我正在使用 perldoc -f require 中提到的对象钩子方法:有三个类似的钩子对象带有子引用的数组,和子引用。这篇文章中的示例是对象挂钩,您可以在 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 仅在这些钩子之后设置。我对任何能让我抛出异常的东西感兴趣。如果尝试加载/重新加载模块,尽管它的状态是不使用我的编译指示的其他模块的依赖项,我想死。

package Foo;
use NEXT;

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

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

如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。

评论(1

旧情勿念 2024-10-03 02:50:11

您可能希望将 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 挂钩不会对已加载的模块执行。如果您还需要挂钩已加载模块的 userequire,则覆盖 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 的维护者,我完全赞成永远阻止人们使用它。 :-)

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. :-)

~没有更多了~
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文