Re: testing for unsuccessful require - mocking require ?

[Fergal Daly]

Below is Hide.pm, you can use it like this

use Hide qw( Foo );

require Bar; # will be fine
require Foo; # will fail

I just wrote it now. It seems to work (even if @INC already contains
subrefs, arrayrefs or objects). You can even use it twice and everything
should just work. It seems to have a problem with XS modules though, I'll
look into that.

If you think it's useful, I'll add docs and a test suite and put it on CPAN,

F

On Sat, Jun 19, 2004 at 09:11:43PM -0200, Gabor Szabo wrote:
> 
> I would like to test a module for unsuccessful "require" while the
> required module is installed. That is I'd like ot test how my code would
> work if Foo.pm was not present.

use strict;
use warnings;

package Hide;

use Scalar::Util qw( blessed reftype );

sub import
{
        my $pkg = shift;
        my @hide = @_;

# these variables are used in the closure below.
        my @inc;
        my %hide;

        @inc = @main::INC;

        @hide = map {s#::#/#g; "$_.pm"} @hide;
        @[EMAIL PROTECTED] = ();

        # replace the real @INC with one which will fail when any of the hidden
        # modules are required but will act like a normal require for all others

        @main::INC = sub {
                my $self = shift;
                my $fn = shift;

                if (exists $hide{$fn})
                {
                        return undef;
                }

                foreach my $path (@inc)
                {
                        my $fh;
                        if (ref $path)
                        {
                                if (blessed $path)
                                {
                                        $fh = $path->INC($fn)
                                }
                                elsif(reftype $path eq "ARRAY")
                                {
                                        $fh = $path->[0]->($path, $fn);
                                }
                                elsif(reftype $path eq "CODE")
                                {
                                        $fh = $path->($path, $fn);
                                }
                        }
                        else
                        {
                                my $full = "$path/$fn";
                                open($fh, $full) || next;
                                $main::INC{$fn}= $full;
                        }
                        return $fh;
                }
                return undef;
        };
}

1;