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.08';
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