Things that didn't work :

BEGIN { @SAVED_INC = @INC; };
sub import {
  @INC = sub {
    # return undef if it's a blocked module
    # Look if the module is in @SAVED_INC
    # Return a filehandle to it
  };
};
[download]

This first variant worked quite well, until I came up to Digest::MD5, which wants to load XS code. And the XS code loader looks through @INC, it dosen't respect coderefs in @INC, and thus, the loading of Digest::MD5 fails. Or rather, Digest::MD5 has a fallback to Digest::Perl::MD5, which I didn't have installed. So this way will not work as soon as we use any module which uses XS code.

So I had to keep all existing directories in @INC, but there was no way to prevent Perl to look through the rest of @INC if my handler returned undef for a blocked module :

BEGIN { @SAVED_INC = @INC; };
sub import {
  @INC = sub {
    # return undef if it's a blocked module
  };
};
[download]

demerphq then suggested that I forget about a handler in @INC and muck instead with %INC and a custom import method, that would die whenever that module was imported into a new namespace.

sub import {
  $INC{$module} = 1;
  *{$module."::import"} = sub {
    die 'ugh';
  };
};
[download]

But this version didn't work, because one could still require the module, and most checks whether a module is available rely on the meme

  eval { require Optional::Module };
  if ($@) {
    # module is not available
  };
[download]

But this put me on the right track, I would simply create a faked module on the fly, and return this faked module whenever I want to prevent a module from loading. I don't need to handle the case that a module is allowed, as the rest of @INC will take care of that.

sub import {
  unshift @INC, sub {
    # return dummy module filehandle if it's a blocked module
  };
};
[download]

There are now some technical pitfalls. First, IO::String does not work in an @INC-handler, seemingly Perl wants a real filehandle (or at least, Acme::Intraweb and PAR do it that way as well), so I have to create a tempfile for every faked module. That's not a real concern as my module is intended for testing anyway - efficiency is of no importance.

Second, what if a module has already been loaded? Then Perl won't go through @INC at all. So we have to scrub %INC as well and clean it of the unwanted modules, in case they have already been loaded.

After these tries, the algorithm to prevent a module from loading now looks like the following :

use vars qw( %forbidden );
sub import {
  my ($self,@forbidden_modules) = @_;
  scrub( $module )
    for @forbidden_modules;
  unshift @INC, sub {
    my (undef,$filename,undef) = @_;
    if (exists $forbidden{$filename}) {
      # return faked, failing module
    };
  };
};
[download]

The complete module is appended below. If you have suggestions about the naming convention or the usage interface, I'd like to hear about them. If you have any hint on how to make my module into a lexical pragma (warnings.pm and strict.pm didn't offer a hint to me), I'll be even more interested.

package Test::Without::Module;
use strict;
use File::Temp;
use Carp qw( croak );

use vars qw( %forbidden $VERSION );
$VERSION = 0.01;

sub import {
  my ($self,@forbidden_modules) = @_;

  $forbidden{$_} = $_
    for @forbidden_modules;

  # Scrub %INC, so that loaded modules disappear
  my ($module);
  for $module (@forbidden_modules) {
    scrub( $module );
  };

  # Move our handler to the front of the list
  @INC = grep { $_ ne \&fake_module } @INC;
  unshift @INC, \&fake_module;
};

sub fake_module {
    my ($self,$module_file,$member_only) = @_;
    warn $@ if $@;

    my $modulename = file2module($module_file);

    # Deliver a faked, nonworking module
    if (grep { $modulename =~ $_ } keys %forbidden) {

      my $fh = File::Temp::tmpfile();
      print $fh <<MODULE;
package $modulename;

=head1 NAME

$modulename

=head1 SYNOPSIS

!!! THIS IS A FAKED VERSION OF $modulename !!!
!!! IT WAS CREATED BY Test::Without::Module          !!!
!!! IT SHOULD NEVER END UP IN YOUR lib/ OR site/lib/ !!!

=cut

sub import { undef };
0;
MODULE
      seek $fh, 0,0;
      return $fh;
    };
};

sub unimport {
  my ($self,@list) = @_;
  my $module;
  for $module (@list) {
    if (exists $forbidden{$module}) {
      delete $forbidden{$module};
      scrub( $module );
    } else {
      croak "Can't allow non-forbidden module $module";
    };
  };
};

sub file2module {
  my ($mod) = @_;
  $mod =~ s!/!::!g;
  $mod =~ s!\.pm$!!;
  $mod;
};

sub scrub {
  my ($module) = @_;
  my $key;
  for $key (keys %INC) {
    delete $INC{$key}
      if (file2module($key) =~ $module);
  };
};

1;
__END__

=head1 NAME

Test::Without::Module - Test fallback behaviour in absence of modules

=head1 SYNOPSIS

=for example begin
  use Test::Without::Module qw( File::Temp );

  # Now, loading of File::Temp fails :
  eval { require File::Temp; };
  warn $@ if $@;

  # Now it works again
  eval q{ no Test::Without::Module qw( File::Temp ) };
  eval { require File::Temp; };
  print "Found File::Temp" unless $@;

=for example end

=head1 DESCRIPTION

This module allows you to deliberately hide modules from a program
even though they are installed. This is mostly useful for testing modu
+les
that have a fallback when a certain dependency module is not installed
+.

=head2 EXPORT

None. All magic is done via C<use Test::Without::Module> and
C<no Test::Without::Module>.

=begin testing
  no warnings 'once';

  eval 'use Test::Without::Module qw( File::Temp )';
  eval 'no Test::Without::Module qw( File::Temp )';

  is_deeply( [keys %Test::Without::Module::forbidden],[],"Module list"
+ );
  eval { require File::Temp; };
  is( $@, '', "unimport" );

=end testing

=head1 BUGS

=over 4

=item * There is no lexicalic scoping (yet)

=back

=head1 AUTHOR

Max Maischein, E<lt>corion@cpan.orgE<gt>

=head1 SEE ALSO

L<Acme::Intraweb>, L<PAR>, L<perlfunc>

=cut
[download]

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]

Update: Fixed calling of scrub. That's what you get for last minute changes !