143 lines
3.3 KiB
Perl
143 lines
3.3 KiB
Perl
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;
|