Devel::Hide - Forces the unavailability of specified Perl modules (for testing)

    use Devel::Hide qw(Module/ToHide.pm);
    require Module::ToHide; # fails 

    use Devel::Hide qw(Test::Pod Test::Pod::Coverage);
    require Test::More; # ok
    use Test::Pod 1.18; # fails

    $ perl -MDevel::Hide=Module::ToHide Makefile.PL

    bash$ PERL5OPT=MDevel::Hide
    bash$ DEVEL_HIDE_PM='Module::Which Test::Pod'
    bash$ export PERL5OPT DEVEL_HIDE_PM
    bash$ perl Makefile.PL

    Devel::Hide hides Module::Which, Test::Pod, etc.

    Can't locate Module/ToHide.pm (hidden)

    perl -MDevel::Hide=Test::Pod Makefile.PL

    perl -MDevel::Hide=XML::SAX script_which_uses_xml_simple.pl

    use Devel::Hide qw(Module/ToHide.pm);
    use lib qw(my_lib);

    $ perl -MDevel::Hide=Devel::Hide -e ''
    Devel::Hide: Too late to hide Devel/Hide.pm

package Devel::Hide;

use 5.006001;
use strict;
use warnings;

our $VERSION = '0.0008';

# blech! package variables
use vars qw( @HIDDEN $VERBOSE );

# a map ( $hidden_file => 1 ) to speed determining if a module/file is hidden
my %IS_HIDDEN;

# whether to hide modules from ...
my %HIDE_FROM = ( 
        children => 0, # child processes or not
);

sub _to_filename {
    my $pm = shift;
    $pm =~ s|::|/|g;
    $pm .= '.pm';
    return $pm;
}

sub _as_filenames {
    return map { /^(\w+::)*\w+$/ ? _to_filename($_) : $_ } @_;
}

BEGIN {

    unless ( defined $VERBOSE ) { # unless user-defined elsewhere, set default
        $VERBOSE
            = defined $ENV{DEVEL_HIDE_VERBOSE} ? $ENV{DEVEL_HIDE_VERBOSE} : 1;
    }

}

# Pushes a list to the set of hidden modules/filenames
# warns about the modules which could not be hidden
# and about the ones that were successfully hidden (if $VERBOSE)
#
# It works as a batch producing warning messages
# at each invocation (when appropriate).
#
sub _push_hidden {

    return unless @_;

    my @too_late;
    for ( _as_filenames(@_) ) {
        if ( $INC{$_} ) {
            push @too_late, $_;
        }
        else {
            $IS_HIDDEN{$_}++;
        }
    }
    if ( $VERBOSE && @too_late ) {
        warn __PACKAGE__, ': Too late to hide ', join( ', ', @too_late ), "\n";
    }
    if ( $VERBOSE && keys %IS_HIDDEN ) {
        warn __PACKAGE__, ' hides ', join( ', ', sort keys %IS_HIDDEN ), "\n";
    }
}

# $ENV{DEVEL_HIDE_PM} is split in ' '
# as well as @HIDDEN it accepts Module::Module as well as File/Names.pm

BEGIN {

    # unless @HIDDEN was user-defined elsewhere, set default
    if ( !defined @HIDDEN && $ENV{DEVEL_HIDE_PM} ) {
        _push_hidden( split q{ }, $ENV{DEVEL_HIDE_PM} );

        # NOTE. "split ' ', $s" is special. Read "perldoc -f split".
    }
    else {
        _push_hidden(@HIDDEN);
    }

    # NOTE. @HIDDEN is not changed anymore

}

# works for perl 5.8.0, uses in-core files
sub _scalar_as_io8 {
    open my $io, '<', \$_[0]
        or die $!;    # this should not happen (perl 5.8 should support this)
    return $io;
}

# works for perl >= 5.6.1, uses File::Temp
sub _scalar_as_io6 {
    my $scalar = shift;
    require File::Temp;
    my $io = File::Temp::tempfile();
    print {$io} $scalar;
    seek $io, 0, 0;    # rewind the handle
    return $io;
}

BEGIN {

    *_scalar_as_io = ( $] >= 5.008 ) ? \&_scalar_as_io8 : \&_scalar_as_io6;

    # _scalar_as_io is one of the two sub's above

}

sub _dont_load {
    my $filename = shift;
    my $oops;
    my $hidden_by = $VERBOSE ? 'hidden' : 'hidden by ' . __PACKAGE__;
    $oops = qq{die "Can't locate $filename ($hidden_by)\n"};
    return _scalar_as_io($oops);
}

sub _is_hidden {
    my $filename = shift;
    return $IS_HIDDEN{$filename};
}

sub _inc_hook {
    my ( $coderef, $filename ) = @_;
    if ( _is_hidden($filename) ) {
        return _dont_load($filename);    # stop right here, with error
    }
    else {
        return undef;                    # go on with the search
    }
}

use lib ( \&_inc_hook );

sub _core_modules {
    require Module::CoreList;    # XXX require 2.05 or newer
    return Module::CoreList->find_modules( qr/.*/, shift );
}

# _append_to_perl5opt(@to_be_hidden)
sub _append_to_perl5opt {

    $ENV{PERL5OPT} = join( ' ',
        defined($ENV{PERL5OPT}) ? $ENV{PERL5OPT} : (),
        'MDevel::Hide=' . join(',', @_)
    );

}

sub import {
    shift;
    if( @_ && $_[0] eq '-from:children' ) {
        $HIDE_FROM{children} = 1;
        shift;
    }
    if (@_) {
        _push_hidden(@_);
        if ($HIDE_FROM{children}) {
            _append_to_perl5opt(@_);
        }
    }

}

# TO DO:
# * write unimport() sub
# * write decent docs
# * refactor private function names
# * RT #25528

1;

__END__