????
Current Path : /proc/self/root/usr/share/perl5/Module/ |
Current File : //proc/self/root/usr/share/perl5/Module/Loaded.pm |
package Module::Loaded; use strict; use Carp qw[carp]; BEGIN { use base 'Exporter'; use vars qw[@EXPORT $VERSION]; $VERSION = '0.08'; @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;