summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authorChris Williams <chris@bingosnet.co.uk>2009-09-04 15:26:15 +0100
committerChris Williams <chris@bingosnet.co.uk>2009-09-04 15:26:15 +0100
commitb6a756ef4a1a1f2f707e954a89a775488a5aa39d (patch)
tree9011c10eae107378515e22e78500f1f3d3f3ec18 /lib
parent7a2ead778a29a9db91ab10890d6716e11c24d680 (diff)
downloadperl-b6a756ef4a1a1f2f707e954a89a775488a5aa39d.tar.gz
Moved Module::Loaded from lib/ to ext/
Diffstat (limited to 'lib')
-rw-r--r--lib/.gitignore1
-rw-r--r--lib/Module/Loaded.pm142
-rw-r--r--lib/Module/Loaded/t/01_Module-Loaded.t47
3 files changed, 1 insertions, 189 deletions
diff --git a/lib/.gitignore b/lib/.gitignore
index d4a915c1b7..4a23dcc91b 100644
--- a/lib/.gitignore
+++ b/lib/.gitignore
@@ -61,6 +61,7 @@
/MIME
/Math/BigInt/FastCalc.pm
/Module/CoreList.pm
+/Module/Loaded.pm
/Module/Pluggable.pm
/Module/Pluggable
/Net/Ping.pm
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" );
-}