Test-Without-Module-0.21/ 0000755 0001750 0001750 00000000000 14345031610 014600 5 ustar corion corion Test-Without-Module-0.21/Texts/ 0000755 0001750 0001750 00000000000 14345031610 015707 5 ustar corion corion Test-Without-Module-0.21/Texts/article.txt 0000755 0001750 0001750 00000016306 13134206462 020110 0 ustar corion corion Title: Preventing a module from loading
I like modules that provide a dynamic fallback and degrade gracefully
if some prerequisites are not available instead of requiring modules
when they can do well without them.
But there is a problem - on my development machine, I have all these
optional modules installed, but I want to test the behaviour of my
code without the optional modules. So I want to set up tests where
the optional modules seem not available. My preferred syntax for this is
a pragma-like syntax :
use Test::Without::Module qw( HTML::Template );
use Test::Without::Module qr/^POE::/;
So, most of the magic will have to be installed in a sub called "import()"
within my (to be written) module.
When you want to muck around with module loading, the only way in Perl
seems to be to add a code reference into @INC. That code reference
either returns a filehandle, from which the text will be loaded,
or undef, which means that the next entry in @INC will be tried.
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
};
};
This first variant worked quite well, until I came up to [cpan://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 [cpan://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
};
};
[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';
};
};
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
};
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
};
};
There are now some technical pitfalls. First, [cpan://IO::String] does not work in
an @INC-handler, seemingly Perl wants a real filehandle (or at least, [cpan://Acme::Intraweb]
and [cpan://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
};
};
};
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 < and
C.
=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, Ecorion@cpan.orgE
=head1 SEE ALSO
L, L, L
=cut
Test-Without-Module-0.21/MANIFEST.SKIP 0000755 0001750 0001750 00000000245 13134206462 016506 0 ustar corion corion ^.cvsignore
^.lwpcookies
^.releaserc
^blib/
^Test-Without-Module-.*
CVS/
^pm_to_blib
.tar.gz$
.old$
^Makefile$
^Releases/
^MANIFEST.bak$
^MYMETA.*
^.git
^.travis.yml Test-Without-Module-0.21/Makefile.PL 0000755 0001750 0001750 00000007535 13134206462 016573 0 ustar corion corion use ExtUtils::MakeMaker;
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
# Normalize version strings like 6.30_02 to 6.3002,
# so that we can do numerical comparisons on it.
my $eumm_version = $ExtUtils::MakeMaker::VERSION;
$eumm_version =~ s/_//;
my $module = 'Test::Without::Module';
(my $main_file = "lib/$module.pm") =~ s!::!/!g;
(my $distname = $module) =~ s!::!-!g;
my $content = do { local(*ARGV,$/)=[$main_file]; <> };
(my $main_version)
= $content =~ m/ [^\n]* \$VERSION \s* = [^=] '([\d_.]+) [^\n]+ /gxms;
my @tests = map {glob $_ } 't/*.t', 't/*/*.t';
my %module = (
'NAME' => 'Test::Without::Module',
'VERSION_FROM' => 'lib/Test/Without/Module.pm', # finds $VERSION
'PREREQ_PM' => {
'Carp' => 0,
}, # e.g., Module::Name => 1.1
ABSTRACT_FROM => 'lib/Test/Without/Module.pm', # retrieve abstract from module
AUTHOR => 'Max Maischein ',
META_MERGE => {
"meta-spec" => { version => 2 },
resources => {
repository => {
web => 'https://github.com/Corion/test-without-module',
url => 'git://github.com/Corion/test-without-module.git',
type => 'git',
},
bugtracker => 'http://rt.cpan.org/Public/Dist/Display.html?Name=' . $distname,
license => 'http://dev.perl.org/licenses/',
},
dynamic_config => 0, # we promise to keep META.* up-to-date
x_static_install => 1, # we are pure Perl and don't do anything fancy
provides => {
$module => {
file => $main_file,
version => $main_version,
}
}
},
BUILD_REQUIRES => {
# Fairly long in core
'File::Find' => 0,
'File::Spec' => 0,
'Test::More' => 0,
},
# Make the version metadata explicit
'LICENSE' => 'perl',
);
sub get_module_info { %module }
if ( ! caller ) {
regen_README($main_file);
#regen_EXAMPLES();
WriteMakefile1(get_module_info);
}
sub WriteMakefile1 { #Written by Alexandr Ciornii, version 0.21. Added by eumm-upgrade.
my %params=@_;
die "EXTRA_META is deprecated" if exists $params{EXTRA_META};
die "License not specified" if not exists $params{LICENSE};
if ($params{BUILD_REQUIRES} and $eumm_version < 6.5503) {
#EUMM 6.5502 has problems with BUILD_REQUIRES
$params{PREREQ_PM}={ %{$params{PREREQ_PM} || {}} , %{$params{BUILD_REQUIRES}} };
delete $params{BUILD_REQUIRES};
}
delete $params{CONFIGURE_REQUIRES} if $eumm_version < 6.52;
delete $params{MIN_PERL_VERSION} if $eumm_version < 6.48;
delete $params{META_MERGE} if $eumm_version < 6.46;
delete $params{META_ADD} if $eumm_version < 6.46;
delete $params{LICENSE} if $eumm_version < 6.31;
delete $params{AUTHOR} if $] < 5.005;
delete $params{ABSTRACT_FROM} if $] < 5.005;
delete $params{BINARY_LOCATION} if $] < 5.005;
WriteMakefile(%params);
}
sub regen_README {
eval {
require Pod::Readme;
my $parser = Pod::Readme->new();
# Read POD from Module.pm and write to README
$parser->parse_from_file($_[0], 'README');
};
eval {
require Pod::Markdown;
my $parser = Pod::Markdown->new();
# Read POD from Module.pm and write to README
$parser->parse_from_file($_[0]);
open my $fh, '>', 'README.mkdn'
or die "Couldn't open 'README.mkdn': $!";
print $fh <as_markdown;
};
}
1;
Test-Without-Module-0.21/t/ 0000755 0001750 0001750 00000000000 14345031610 015043 5 ustar corion corion Test-Without-Module-0.21/t/06-missing-hidden-modules.t 0000644 0001750 0001750 00000002273 14345031600 022026 0 ustar corion corion
use Test::Without::Module;
use Test::More tests => 5;
sub tryload {
my $module = shift;
my $failed = !eval "require $module; 1";
my $error = $@;
$error =~ s/(\(\@INC contains: ).*\)/$1...)/;
$error =~ s/\n+\z//;
my $inc_status = !exists $INC{"$module.pm"} ? 'missing'
: !defined $INC{"$module.pm"} ? 'undef'
: !$INC{"$module.pm"} ? 'false'
: '"'.$INC{"$module.pm"}.'"'
;
return $failed, $error, $inc_status;
}
my ($failed,$error,$inc) = tryload( 'Nonexisting::Module' );
is $failed, 1, "Self-test, a non-existing module fails to load";
like $error, qr!^Can't locate Nonexisting/Module.pm in \@INC( \(you may need to install the Nonexisting::Module module\))? \(\@INC !,
'Self-test, error message shows @INC';
#diag $error;
# Now, hide a module that has not been loaded:
ok !$INC{'IO/Socket.pm'}, "Module 'IO/Socket.pm' has not been loaded yet";
Test::Without::Module->import('IO::Socket');
($failed,$error,$inc) = tryload( 'IO::Socket' );
is $failed, 1, "a non-existing module fails to load";
like $error, qr!Can't locate IO/Socket.pm in \@INC( \(you may need to install the IO::Socket module\))? \(\@INC !, 'error message for hidden module shows @INC';
#diag $error;
Test-Without-Module-0.21/t/embedded-Test-Without-Module.t 0000755 0001750 0001750 00000003443 13134206462 022575 0 ustar corion corion #!D:\Programme\indigoperl-5.6\bin\perl.exe -w
use Test::More 'no_plan';
package Catch;
sub TIEHANDLE {
my($class, $var) = @_;
return bless { var => $var }, $class;
}
sub PRINT {
my($self) = shift;
${'main::'.$self->{var}} .= join '', @_;
}
sub OPEN {} # XXX Hackery in case the user redirects
sub CLOSE {} # XXX STDERR/STDOUT. This is not the behavior we want.
sub READ {}
sub READLINE {}
sub GETC {}
sub BINMODE {}
my $Original_File = 'D:lib\Test\Without\Module.pm';
package main;
# pre-5.8.0's warns aren't caught by a tied STDERR.
$SIG{__WARN__} = sub { $main::_STDERR_ .= join '', @_; };
tie *STDOUT, 'Catch', '_STDOUT_' or die $!;
tie *STDERR, 'Catch', '_STDERR_' or die $!;
SKIP: {
# A header testing whether we find all prerequisites :
# Check for module My::Module
eval { require My::Module };
skip "Need module My::Module to run this test", 1
if $@;
# Check for module Test::Without::Module
eval { require Test::Without::Module };
skip "Need module Test::Without::Module to run this test", 1
if $@;
# The original POD test
undef $main::_STDOUT_;
undef $main::_STDERR_;
eval q{
my $example = sub {
local $^W = 0;
#line 109 lib/Test/Without/Module.pm
use Test::Without::Module qw( My::Module );
# Now, loading of My::Module fails :
eval { require My::Module; };
warn $@ if $@;
# Now it works again
eval q{ no Test::Without::Module qw( My::Module ) };
eval { require My::Module; };
print "Found My::Module" unless $@;
;
}
};
is($@, '', "example from line 109");
};
SKIP: {
# A header testing whether we find all prerequisites :
# The original POD test
undef $main::_STDOUT_;
undef $main::_STDERR_;
};
Test-Without-Module-0.21/t/01-api.t 0000755 0001750 0001750 00000000126 13134206462 016225 0 ustar corion corion #!/usr/bin/perl -w
use Test::More tests => 1;
use_ok( 'Test::Without::Module' ); Test-Without-Module-0.21/t/03-block-require-module.t 0000755 0001750 0001750 00000001534 13134206462 021511 0 ustar corion corion #!/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 };
use Test::Without::Module qw( Digest::MD5 );
ok( $@ ne '', "Loading raised error");
like( $@, qr!^(Can't locate Digest/MD5.pm in \@INC|Digest/MD5.pm did not return a true value at)!, "Hid module");
is_deeply( [sort keys %{Test::Without::Module::get_forbidden_list()}],[ qw[ Digest/MD5.pm ]],"Module list" );
delete_package( 'Digest::MD5' );
};
TODO: {
local $TODO = 'Implement lexical scoping';
eval { require 'Digest::MD5' };
is( $@, '', "Local (require) confinement");
delete_package( 'Digest::MD5' );
eval q{ use Digest::MD5 };
is( $@, '', "Local (use) confinement");
}; Test-Without-Module-0.21/t/02-block-use-module.t 0000755 0001750 0001750 00000000655 13134206462 020633 0 ustar corion corion #!/usr/bin/perl -w
use strict;
use Test::More tests => 4;
BEGIN{ use_ok( "Test::Without::Module", qw( Digest::MD5 )); };
is_deeply( [sort keys %{Test::Without::Module::get_forbidden_list()}],[ qw[ Digest/MD5.pm ]],"Module list" );
eval q{ use Digest::MD5 };
ok( $@ ne '', 'Importing raises an error' );
like( $@, qr!^(Can't locate Digest/MD5.pm in \@INC|Digest/MD5.pm did not return a true value at)!, "Hid module"); Test-Without-Module-0.21/t/05-redefine.t 0000644 0001750 0001750 00000000767 13134206462 017251 0 ustar corion corion #!/usr/bin/perl -w
use strict;
use Test::More tests => 1;
use File::Find;
my @warnings;
BEGIN {
$SIG{__WARN__} = sub {
push @warnings, @_;
};
};
use Data::Dumper;
#BEGIN { diag $INC{"File/Find.pm"}; };
use Test::Without::Module qw(File::Find);
#BEGIN { diag $INC{"File/Find.pm"}; };
no Test::Without::Module qw(File::Find);
#diag $INC{"File/Find.pm"};
require File::Find;
# diag Dumper \%INC;
is_deeply "@warnings", "", "No warnings were issued upon re-allowing a module";
__END__
Test-Without-Module-0.21/t/04-import-export.t 0000755 0001750 0001750 00000000527 13134206462 020315 0 ustar corion corion #!/usr/bin/perl -w
use Test::More tests => 3;
use_ok( 'Test::Without::Module' );
use Test::Without::Module qw( File::Temp );
no Test::Without::Module qw( File::Temp );
is_deeply( [keys %{Test::Without::Module::get_forbidden_list()}],[],"Module list is empty" );
eval { $^W = 0; require File::Temp; };
is( $@, '', "unimport" );
Test-Without-Module-0.21/t/rt122551.t 0000644 0001750 0001750 00000001407 14345031600 016336 0 ustar corion corion #!/usr/bin/perl -w
use strict;
use Test::More tests => 2;
BEGIN {
if( ! eval { require Module::Load::Conditional; 1 }) {
SKIP: {
skip "Module::Load::Conditional not installed: $@", 2;
};
};
};
use Test::Without::Module qw(Test::More);
local $TODO = 'Module::Load::Conditional doesn\'t guard against failures in @INC hook';
my $lived = eval {
my $res = Module::Load::Conditional::can_load(
modules => {
'Test::More' => undef,
}
);
ok !$res, "We don't load Test::More";
1;
};
ok $lived or diag "Caught error $@";
diag "Test::Without::Module: $Test::Without::Module::VERSION";
diag "Module::Load::Conditional: $Module::Load::Conditional::VERSION";
done_testing;
Test-Without-Module-0.21/README.mkdn 0000644 0001750 0001750 00000005720 14345031607 016422 0 ustar corion corion
[](https://github.com/Corion/test-without-module)
# NAME
Test::Without::Module - Test fallback behaviour in absence of modules
# SYNOPSIS
use Test::Without::Module qw( My::Module );
# Now, loading of My::Module fails :
eval { require My::Module; };
warn $@ if $@;
# Now it works again
eval q{ no Test::Without::Module qw( My::Module ) };
eval { require My::Module; };
print "Found My::Module" unless $@;
# DESCRIPTION
This module allows you to deliberately hide modules from a program
even though they are installed. This is mostly useful for testing modules
that have a fallback when a certain dependency module is not installed.
## EXPORT
None. All magic is done via `use Test::Without::Module LIST` and
`no Test::Without::Module LIST`.
## Test::Without::Module::get\_forbidden\_list
This function returns a reference to a copy of the current hash of forbidden
modules or an empty hash if none are currently forbidden. This is convenient
if you are testing and/or debugging this module.
# ONE LINER
A neat trick for using this module from the command line
was mentioned to me by NUFFIN and by Jerrad Pierce:
perl -MTest::Without::Module=Some::Module -w -Iblib/lib t/SomeModule.t
That way, you can easily see how your module or test file behaves
when a certain module is unavailable.
# BUGS
- There is no lexical scoping
# CREDITS
Much improvement must be thanked to Aristotle from PerlMonks, he pointed me
to a much less convoluted way to fake a module at
[https://perlmonks.org?node=192635](https://perlmonks.org?node=192635).
I also discussed with him an even more elegant way of overriding
CORE::GLOBAL::require, but the parsing of the overridden subroutine
didn't work out the way I wanted it - CORE::require didn't recognize
barewords as such anymore.
NUFFIN and Jerrad Pierce pointed out the convenient
use from the command line to interactively watch the
behaviour of the test suite and module in absence
of a module.
# AUTHOR
Copyright (c) 2003-2014 Max Maischein,
# LICENSE
This module is released under the same terms as Perl itself.
# REPOSITORY
The public repository of this module is
[https://github.com/Corion/test-without-module](https://github.com/Corion/test-without-module).
# SUPPORT
The public support forum of this module is
[https://perlmonks.org/](https://perlmonks.org/).
# BUG TRACKER
Please report bugs in this module via the RT CPAN bug queue at
[https://rt.cpan.org/Public/Dist/Display.html?Name=Test-Without-Module](https://rt.cpan.org/Public/Dist/Display.html?Name=Test-Without-Module)
or via mail to [test-without-module-Bugs@rt.cpan.org](https://metacpan.org/pod/test-without-module-Bugs%40rt.cpan.org).
# SEE ALSO
[Devel::Hide](https://metacpan.org/pod/Devel%3A%3AHide), [Acme::Intraweb](https://metacpan.org/pod/Acme%3A%3AIntraweb), [PAR](https://metacpan.org/pod/PAR), [perlfunc](https://metacpan.org/pod/perlfunc)
Test-Without-Module-0.21/META.yml 0000644 0001750 0001750 00000001472 14345031610 016055 0 ustar corion corion ---
abstract: 'Test fallback behaviour in absence of modules'
author:
- 'Max Maischein '
build_requires:
File::Find: '0'
File::Spec: '0'
Test::More: '0'
configure_requires:
ExtUtils::MakeMaker: '0'
dynamic_config: 0
generated_by: 'ExtUtils::MakeMaker version 7.44, CPAN::Meta::Converter version 2.150010'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: '1.4'
name: Test-Without-Module
no_index:
directory:
- t
- inc
provides:
Test::Without::Module:
file: lib/Test/Without/Module.pm
version: '0.21'
requires:
Carp: '0'
resources:
license: http://dev.perl.org/licenses/
repository: git://github.com/Corion/test-without-module.git
version: '0.21'
x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
x_static_install: 1
Test-Without-Module-0.21/lib/ 0000755 0001750 0001750 00000000000 14345031610 015346 5 ustar corion corion Test-Without-Module-0.21/lib/Test/ 0000755 0001750 0001750 00000000000 14345031610 016265 5 ustar corion corion Test-Without-Module-0.21/lib/Test/Without/ 0000755 0001750 0001750 00000000000 14345031610 017730 5 ustar corion corion Test-Without-Module-0.21/lib/Test/Without/Module.pm 0000755 0001750 0001750 00000010161 14345031600 021514 0 ustar corion corion package Test::Without::Module;
use strict;
use Carp qw( croak );
use vars qw( $VERSION );
$VERSION = '0.21';
use vars qw(%forbidden);
sub get_forbidden_list {
\%forbidden
};
sub import {
my ($self,@forbidden_modules) = @_;
my $forbidden = get_forbidden_list;
for (@forbidden_modules) {
my $file = module2file($_);
$forbidden->{$file} = delete $INC{$file};
};
# Scrub %INC, so that loaded modules disappear
for my $module (@forbidden_modules) {
scrub( $module );
};
@INC = (\&fake_module, grep { !ref || $_ != \&fake_module } @INC);
};
sub fake_module {
my ($self,$module_file,$member_only) = @_;
# Don't touch $@, or .al files will not load anymore????
if (exists get_forbidden_list->{$module_file}) {
my $module_name = file2module($module_file);
croak "Can't locate $module_file in \@INC (you may need to install the $module_name module) (\@INC contains: @INC)";
};
};
sub unimport {
my ($self,@list) = @_;
my $module;
my $forbidden = get_forbidden_list;
for $module (@list) {
my $file = module2file($module);
if (exists $forbidden->{$file}) {
my $path = delete $forbidden->{$file};
if (defined $path) {
$INC{ $file } = $path;
}
} else {
croak "Can't allow non-forbidden module $module";
};
};
};
sub file2module {
my ($mod) = @_;
$mod =~ s!/!::!g;
$mod =~ s!\.pm$!!;
$mod;
};
sub module2file {
my ($mod) = @_;
$mod =~ s!::|'!/!g;
$mod .= ".pm";
$mod;
};
sub scrub {
my ($module) = @_;
delete $INC{module2file($module)};
};
1;
=head1 NAME
Test::Without::Module - Test fallback behaviour in absence of modules
=head1 SYNOPSIS
use Test::Without::Module qw( My::Module );
# Now, loading of My::Module fails :
eval { require My::Module; };
warn $@ if $@;
# Now it works again
eval q{ no Test::Without::Module qw( My::Module ) };
eval { require My::Module; };
print "Found My::Module" unless $@;
=head1 DESCRIPTION
This module allows you to deliberately hide modules from a program
even though they are installed. This is mostly useful for testing modules
that have a fallback when a certain dependency module is not installed.
=head2 EXPORT
None. All magic is done via C