http://www.perlmonks.org?node_id=1007731

sedusedan has asked for the wisdom of the Perl Monks concerning the following question:

I'm just wondering, is there a way for an import hook to cancel/ignore/no-op a require() so that this code works?

unshift @INC, \&import_hook; require Foo; # nothing is loaded require Bar; # nothing is loaded

I've tried:

unshift @INC, sub { return (undef, sub {0}); }

use Tie::Handle::Scalar; unshift @INC, sub { tie *FH, "Tie::Handle::Scalar", ""; # or "1;\n" #$INC{$name} = undef; # or $name. testing return (*FH); }

Perl seems to go to the next @INC entry for all the above two cases. What am I doing wrong?

Replies are listed 'Best First'.
Re: Cancel/no-op a require
by tobyink (Canon) on Dec 07, 2012 at 13:16 UTC

    Try thanks.

    no thanks qw(Foo Bar); use Foo; # no-op require Bar; # no-op
    perl -E'sub Monkey::do{say$_,for@_,do{($monkey=[caller(0)]->[3])=~s{::}{ }and$monkey}}"Monkey say"->Monkey::do'

      :) (obvious pun avoided)

      My problem at hand is actually grok-ing the @INC import hook API and avoiding duplicate importing. I'm trying to add a feature to Log::Any::For::Package to install import hook. If user specifies Foo::* in the list of packages to add logging to, then after some Foo::* module is loaded, I want the hook to add logging to the newly loaded package automatically. With this:

      unshift @INC, sub { my ($self, $name) = @_; # load the module first local @INC = grep { !ref($_) || $_ != $self } @INC; require $name; # add logging to the package # instruct Perl to not load the module again };

      Perl is loading the module twice, resulting in "subroutine X redefined" errors.

      This works, BTW, though I'm not sure it is proper (or even, exactly how).

      unshift @INC, sub { my ($self, $name) = @_; $INC{$name} = 1; # load the module first local @INC = grep { !ref($_) || $_ != $self } @INC; require $name; # add logging to the package return (); };

        OK, so now the correct incantation should be:

        unshift @INC, sub { my ($self, $name) = @_; # load the module first local @INC = grep { !ref($_) || $_ != $self } @INC; require $name; # add logging to the package # ignore this hook my $line = 0; return sub { unless ($line++) { $_ = "1;\n"; return 1; } return 0; } };

Re: Cancel/no-op a require (%INC)
by tye (Sage) on Dec 07, 2012 at 14:24 UTC

    If making 'use Foo' and 'require Bar' be no-ops is your primary goal, then it is easier to not do that via a hook in @INC (use %INC instead):

    BEGIN { $INC{'Foo.pm'} = $INC{'Bar.pm'} = __FILE__ } use Foo; # no-op require Bar; # no-op

    - tye        

      Module::Loaded - mark modules as loaded or unloaded
      use Module::Loaded; $bool = mark_as_loaded('Foo'); # Foo.pm is now marked as loaded $loc = is_loaded('Foo'); # location of Foo.pm set to the # loaders location eval "require 'Foo'"; # is now a no-op $bool = mark_as_unloaded('Foo'); # Foo.pm no longer marked as loaded eval "require 'Foo'"; # Will try to find Foo.pm in @INC
Re: Cancel/no-op a require
by tobyink (Canon) on Dec 07, 2012 at 13:35 UTC

    Also, if you really want to use a hook in @INC, this is how they work...

    unshift @INC, sub { my $module = $_[1]; if ($module eq 'Foo.pm') { $INC{$module}++; my $line = 0; return sub { unless ($line++) { $_ = "1;\n"; return 1; } return 0; } } return; }; require Foo; # no-op
    perl -E'sub Monkey::do{say$_,for@_,do{($monkey=[caller(0)]->[3])=~s{::}{ }and$monkey}}"Monkey say"->Monkey::do'

      Ah, so this particular sentence in perlfunc is the one that gets me confused: The subroutine should return either nothing or else a list of up to three values in the following order.

      So instead of returning (undef, sub{...}) I should've just returned (sub {...}).

      Thanks, Toby.

        Also the innards of the function are kinda odd. You need to assign lines to $_ rather than returning them. I can understand why they did it that way, but it's pretty strange.

        perl -E'sub Monkey::do{say$_,for@_,do{($monkey=[caller(0)]->[3])=~s{::}{ }and$monkey}}"Monkey say"->Monkey::do'
        So instead of returning (undef, sub{...}) I should've just returned (sub {...}).

        The documentation is correct, returning your way might work, but is wrong according to the documentation. Instead I guess the important part you made wrong before is not returning a reference to a scalar for source code prefix as element 1. This is what I've been struggling with, which resulted in strange behaviour, like the returned filehandle in my returned list got read once, but not for a second file and such. Instead of returning a reference to a scalar, I tried to return undef, \'' or plain '', which all failed. When I started to really use a scalar, the return worked as documented: The file in my case got read using the handle and I could warn each line read in the given sub. It's important as well to really end the reading with 0 in the sub, else Perl will try to read data in some endless loop.

        my $prefix = ''; # undef is valid as well return (\$prefix, IO::File->new($path, '<:bytes'), sub { $_ =~ /^1;\s*$/ ? 0 : 1 }, undef);