Loaded.pm revision 1.1.1.1
1package Module::Loaded; 2 3use strict; 4use Carp qw[carp]; 5 6BEGIN { use base 'Exporter'; 7 use vars qw[@EXPORT $VERSION]; 8 9 $VERSION = '0.06'; 10 @EXPORT = qw[mark_as_loaded mark_as_unloaded is_loaded]; 11} 12 13=head1 NAME 14 15Module::Loaded - mark modules as loaded or unloaded 16 17=head1 SYNOPSIS 18 19 use Module::Loaded; 20 21 $bool = mark_as_loaded('Foo'); # Foo.pm is now marked as loaded 22 $loc = is_loaded('Foo'); # location of Foo.pm set to the 23 # loaders location 24 eval "require 'Foo'"; # is now a no-op 25 26 $bool = mark_as_unloaded('Foo'); # Foo.pm no longer marked as loaded 27 eval "require 'Foo'"; # Will try to find Foo.pm in @INC 28 29=head1 DESCRIPTION 30 31When testing applications, often you find yourself needing to provide 32functionality in your test environment that would usually be provided 33by external modules. Rather than munging the C<%INC> by hand to mark 34these external modules as loaded, so they are not attempted to be loaded 35by perl, this module offers you a very simple way to mark modules as 36loaded and/or unloaded. 37 38=head1 FUNCTIONS 39 40=head2 $bool = mark_as_loaded( PACKAGE ); 41 42Marks the package as loaded to perl. C<PACKAGE> can be a bareword or 43string. 44 45If the module is already loaded, C<mark_as_loaded> will carp about 46this and tell you from where the C<PACKAGE> has been loaded already. 47 48=cut 49 50sub mark_as_loaded (*) { 51 my $pm = shift; 52 my $file = __PACKAGE__->_pm_to_file( $pm ) or return; 53 my $who = [caller]->[1]; 54 55 my $where = is_loaded( $pm ); 56 if ( defined $where ) { 57 carp "'$pm' already marked as loaded ('$where')"; 58 59 } else { 60 $INC{$file} = $who; 61 } 62 63 return 1; 64} 65 66=head2 $bool = mark_as_unloaded( PACKAGE ); 67 68Marks the package as unloaded to perl, which is the exact opposite 69of C<mark_as_loaded>. C<PACKAGE> can be a bareword or string. 70 71If the module is already unloaded, C<mark_as_unloaded> will carp about 72this and tell you the C<PACKAGE> has been unloaded already. 73 74=cut 75 76sub mark_as_unloaded (*) { 77 my $pm = shift; 78 my $file = __PACKAGE__->_pm_to_file( $pm ) or return; 79 80 unless( defined is_loaded( $pm ) ) { 81 carp "'$pm' already marked as unloaded"; 82 83 } else { 84 delete $INC{ $file }; 85 } 86 87 return 1; 88} 89 90=head2 $loc = is_loaded( PACKAGE ); 91 92C<is_loaded> tells you if C<PACKAGE> has been marked as loaded yet. 93C<PACKAGE> can be a bareword or string. 94 95It returns falls if C<PACKAGE> has not been loaded yet and the location 96from where it is said to be loaded on success. 97 98=cut 99 100sub is_loaded (*) { 101 my $pm = shift; 102 my $file = __PACKAGE__->_pm_to_file( $pm ) or return; 103 104 return $INC{$file} if exists $INC{$file}; 105 106 return; 107} 108 109 110sub _pm_to_file { 111 my $pkg = shift; 112 my $pm = shift or return; 113 114 my $file = join '/', split '::', $pm; 115 $file .= '.pm'; 116 117 return $file; 118} 119 120=head1 BUG REPORTS 121 122Please report bugs or other issues to E<lt>bug-module-loaded@rt.cpan.org<gt>. 123 124=head1 AUTHOR 125 126This module by Jos Boumans E<lt>kane@cpan.orgE<gt>. 127 128=head1 COPYRIGHT 129 130This library is free software; you may redistribute and/or modify it 131under the same terms as Perl itself. 132 133=cut 134 135# Local variables: 136# c-indentation-style: bsd 137# c-basic-offset: 4 138# indent-tabs-mode: nil 139# End: 140# vim: expandtab shiftwidth=4: 141 1421; 143