diff options
author | Chris Williams <chris@bingosnet.co.uk> | 2009-09-04 15:26:15 +0100 |
---|---|---|
committer | Chris Williams <chris@bingosnet.co.uk> | 2009-09-04 15:26:15 +0100 |
commit | b6a756ef4a1a1f2f707e954a89a775488a5aa39d (patch) | |
tree | 9011c10eae107378515e22e78500f1f3d3f3ec18 /lib/Module | |
parent | 7a2ead778a29a9db91ab10890d6716e11c24d680 (diff) | |
download | perl-b6a756ef4a1a1f2f707e954a89a775488a5aa39d.tar.gz |
Moved Module::Loaded from lib/ to ext/
Diffstat (limited to 'lib/Module')
-rw-r--r-- | lib/Module/Loaded.pm | 142 | ||||
-rw-r--r-- | lib/Module/Loaded/t/01_Module-Loaded.t | 47 |
2 files changed, 0 insertions, 189 deletions
diff --git a/lib/Module/Loaded.pm b/lib/Module/Loaded.pm deleted file mode 100644 index 6741844e37..0000000000 --- a/lib/Module/Loaded.pm +++ /dev/null @@ -1,142 +0,0 @@ -package Module::Loaded; - -use strict; -use Carp qw[carp]; - -BEGIN { use base 'Exporter'; - use vars qw[@EXPORT $VERSION]; - - $VERSION = '0.02'; - @EXPORT = qw[mark_as_loaded mark_as_unloaded is_loaded]; -} - -=head1 NAME - -Module::Loaded - mark modules as loaded or unloaded - -=head1 SYNOPSIS - - use Module::Loaded; - - $bool = mark_as_loaded('Foo'); # Foo.pm is now marked as loaded - $loc = is_loaded('Foo'); # location of Foo.pm set to the - # loaders location - eval "require 'Foo'"; # is now a no-op - - $bool = mark_as_unloaded('Foo'); # Foo.pm no longer marked as loaded - eval "require 'Foo'"; # Will try to find Foo.pm in @INC - -=head1 DESCRIPTION - -When testing applications, often you find yourself needing to provide -functionality in your test environment that would usually be provided -by external modules. Rather than munging the C<%INC> by hand to mark -these external modules as loaded, so they are not attempted to be loaded -by perl, this module offers you a very simple way to mark modules as -loaded and/or unloaded. - -=head1 FUNCTIONS - -=head2 $bool = mark_as_loaded( PACKAGE ); - -Marks the package as loaded to perl. C<PACKAGE> can be a bareword or -string. - -If the module is already loaded, C<mark_as_loaded> will carp about -this and tell you from where the C<PACKAGE> has been loaded already. - -=cut - -sub mark_as_loaded (*) { - my $pm = shift; - my $file = __PACKAGE__->_pm_to_file( $pm ) or return; - my $who = [caller]->[1]; - - my $where = is_loaded( $pm ); - if ( defined $where ) { - carp "'$pm' already marked as loaded ('$where')"; - - } else { - $INC{$file} = $who; - } - - return 1; -} - -=head2 $bool = mark_as_unloaded( PACKAGE ); - -Marks the package as unloaded to perl, which is the exact opposite -of C<mark_as_loaded>. C<PACKAGE> can be a bareword or string. - -If the module is already unloaded, C<mark_as_unloaded> will carp about -this and tell you the C<PACKAGE> has been unloaded already. - -=cut - -sub mark_as_unloaded (*) { - my $pm = shift; - my $file = __PACKAGE__->_pm_to_file( $pm ) or return; - - unless( defined is_loaded( $pm ) ) { - carp "'$pm' already marked as unloaded"; - - } else { - delete $INC{ $file }; - } - - return 1; -} - -=head2 $loc = is_loaded( PACKAGE ); - -C<is_loaded> tells you if C<PACKAGE> has been marked as loaded yet. -C<PACKAGE> can be a bareword or string. - -It returns falls if C<PACKAGE> has not been loaded yet and the location -from where it is said to be loaded on success. - -=cut - -sub is_loaded (*) { - my $pm = shift; - my $file = __PACKAGE__->_pm_to_file( $pm ) or return; - - return $INC{$file} if exists $INC{$file}; - - return; -} - - -sub _pm_to_file { - my $pkg = shift; - my $pm = shift or return; - - my $file = join '/', split '::', $pm; - $file .= '.pm'; - - return $file; -} - -=head1 BUG REPORTS - -Please report bugs or other issues to E<lt>bug-module-loaded@rt.cpan.org<gt>. - -=head1 AUTHOR - -This module by Jos Boumans E<lt>kane@cpan.orgE<gt>. - -=head1 COPYRIGHT - -This library is free software; you may redistribute and/or modify it -under the same terms as Perl itself. - -=cut - -# Local variables: -# c-indentation-style: bsd -# c-basic-offset: 4 -# indent-tabs-mode: nil -# End: -# vim: expandtab shiftwidth=4: - -1; diff --git a/lib/Module/Loaded/t/01_Module-Loaded.t b/lib/Module/Loaded/t/01_Module-Loaded.t deleted file mode 100644 index f4c1a46eef..0000000000 --- a/lib/Module/Loaded/t/01_Module-Loaded.t +++ /dev/null @@ -1,47 +0,0 @@ -use strict; -use Test::More 'no_plan'; - -my $Class = 'Module::Loaded'; -my @Funcs = qw[mark_as_loaded mark_as_unloaded is_loaded]; -my $Mod = 'Foo::Bar'.$$; -my $Strict = 'strict'; - -### load the thing -{ use_ok( $Class ); - can_ok( $Class, @Funcs ); -} - -{ ok( !is_loaded($Mod), "$Mod not loaded yet" ); - ok( mark_as_loaded($Mod), " $Mod now marked as loaded" ); - is( is_loaded($Mod), $0, " $Mod is loaded from $0" ); - - my $rv = eval "require $Mod; 1"; - ok( $rv, "$Mod required" ); - ok( !$@, " require did not die" ); -} - -### unload again -{ ok( mark_as_unloaded($Mod), "$Mod now marked as unloaded" ); - ok( !is_loaded($Mod), " $Mod now longer loaded" ); - - my $rv = eval "require $Mod; 1"; - ok( !$rv, "$Mod require failed" ); - ok( $@, " require died" ); - like( $@, qr/locate/, " with expected error" ); -} - -### check for an already loaded module -{ my $where = is_loaded( $Strict ); - ok( $where, "$Strict loaded" ); - ok( mark_as_unloaded( $Strict ), - " $Strict unloaded" ); - - ### redefining subs, quell warnings - { local $SIG{__WARN__} = sub {}; - my $rv = eval "require $Strict; 1"; - ok( $rv, "$Strict loaded again" ); - } - - is( is_loaded( $Strict ), $where, - " $Strict is loaded" ); -} |