in reply to RFC: Preventing a module from loading

You can avoid the temporary files, as I demonstrated at Coderefs in @INC (was: Building a Simple Perl Module Database). Your approach seems like an awful lot of work though - especially as it will fail to work correctly if any module mucks with @INC too much (such as by unshifting an extra path).

Wouldn't something along the lines of the following work better?

#### untested ####

package Test::Without::Module;

use constant REQUIRE_ERROR => q/Can't locate %s.pm in @INC (@INC conta
+ins: %s)/;

my @dont_load_rx;

sub import {
    my $class = shift;
    push @dont_load_rx, map qr/$_/, @_;
}

# prototype("CORE::require") eq ";$"
*CORE::GLOBAL::require = sub (;$) {
    local $_ = $_[0];
    for my $forbidden (@dont_load) {
        /$forbidden/ or next;
        s!::!/!; # possibly OS dependent?
        require Carp;
        Carp::croak(sprintf REQUIRE_ERROR, $_, "@INC");
    }
    goto CORE::require;
};

1;

[download]
Update: switched from die to croak, used goto to chain to the core require, to make the module more transparent to the outside world.

Makeshifts last the longest.

Replies are listed 'Best First'.
Re: Re: RFC: Preventing a module from loading
by Corion (Patriarch) on Feb 18, 2003 at 21:14 UTC

    That idea is much cleaner and removes much of the clutter I've amassed from the above way to reaching my goal. But it dosen't completely work, as perls parsing gets in the way :

    I use this as the subsitute - neither the prototype of $ nor the prototype of * (suggested here did make a difference. *CORE::GLOBAL::require = sub (*) { my $forbidden = get_forbidden_list; local $_ = $_[0]; for my $forbidden_module (keys %{$forbidden}) { /$forbidden_module/ or next; s!::!/!g; require Carp; Carp::croak(sprintf REQUIRE_ERROR, $_, "@INC"); } print "Loading original via @_\n"; goto CORE::require; };

    The following test dies with Can't locate Test::Without::Module in @INC..., which suggests to me that somehow my faked require dosen't quite parse like the real thing to perl (or rather, the bareword module name isn't seen as such anymore by the real require) :

    #!/usr/bin/perl -w
use strict;
use Symbol qw( delete_package );
use Test::More tests => 6;

BEGIN { use_ok( "Test::Without::Module", qw( Digest::MD5 )); };

{
  use Test::Without::Module qw( Digest::MD5 );

  eval { require Digest::MD5 };
  ok( $@ ne '', "Loading raised error");
  like( $@, qr!^Can't locate Digest/MD5.pm in \@INC!, "Hid module");
  is_deeply( [sort keys %{Test::Without::Module::get_forbidden_list()}
+],[ qw[ Digest::MD5 ]],"Module list" );
  delete_package( 'Digest::MD5' );
};

    [download]

    It gets weirder - I can prevent the original require from seeing @_ by using my $name = $_[0] as the first line of the sub instead. So somehow, this beautiful solution dosen't work for me and Perl 5.6.1 :-((

    perl -MHTTP::Daemon -MHTTP::Response -MLWP::Simple -e ' ;    # The  
$d = new HTTP::Daemon and fork and getprint $d->url and exit;#spider
($c = $d->accept())->get_request(); $c->send_response( new   #in the
HTTP::Response(200,$_,$_,qq(Just another Perl hacker\n))); ' #  web

    [download]
[reply]
[d/l]
[select]
      Maybe you could post the new code as well so I can have a stab at running the test suite against it and possibly fixing it?

      Makeshifts last the longest.

[reply]

In Section Meditations