Commit | Line | Data |
271e5113 |
1 | package Module::Loaded; |
2 | |
3 | use strict; |
4 | use Carp qw[carp]; |
5 | |
6 | BEGIN { use base 'Exporter'; |
7 | use vars qw[@EXPORT $VERSION]; |
8 | |
9 | $VERSION = '0.01'; |
10 | @EXPORT = qw[mark_as_loaded mark_as_unloaded is_loaded]; |
11 | } |
12 | |
13 | =head1 NAME |
14 | |
15 | Module::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 | |
31 | When testing applications, often you find yourself needing to provide |
32 | functionality in your test environment that would usually be provided |
33 | by external modules. Rather than munging the C<%INC> by hand to mark |
34 | these external modules as loaded, so they are not attempted to be loaded |
35 | by perl, this module offers you a very simple way to mark modules as |
36 | loaded and/or unloaded. |
37 | |
38 | =head1 FUNCTIONS |
39 | |
40 | =head2 $bool = mark_as_loaded( PACKAGE ); |
41 | |
42 | Marks the package as loaded to perl. C<PACKAGE> can be a bareword or |
43 | string. |
44 | |
45 | If the module is already loaded, C<mark_as_loaded> will carp about |
46 | this and tell you from where the C<PACKAGE> has been loaded already. |
47 | |
48 | =cut |
49 | |
50 | sub 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 | |
68 | Marks the package as unloaded to perl, which is the exact opposite |
69 | of C<mark_as_loaded>. C<PACKAGE> can be a bareword or string. |
70 | |
71 | If the module is already unloaded, C<mark_as_unloaded> will carp about |
72 | this and tell you the C<PACKAGE> has been unloaded already. |
73 | |
74 | =cut |
75 | |
76 | sub 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 | |
92 | C<is_loaded> tells you if C<PACKAGE> has been marked as loaded yet. |
93 | C<PACKAGE> can be a bareword or string. |
94 | |
95 | It returns falls if C<PACKAGE> has not been loaded yet and the location |
96 | from where it is said to be loaded on success. |
97 | |
98 | =cut |
99 | |
100 | sub 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 | |
110 | sub _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 AUTHOR |
121 | |
122 | This module by |
123 | Jos Boumans E<lt>kane@cpan.orgE<gt>. |
124 | |
125 | =head1 COPYRIGHT |
126 | |
127 | This module is |
128 | copyright (c) 2004-2005 Jos Boumans E<lt>kane@cpan.orgE<gt>. |
129 | All rights reserved. |
130 | |
131 | This library is free software; |
132 | you may redistribute and/or modify it under the same |
133 | terms as Perl itself. |
134 | |
135 | =cut |
136 | |
137 | # Local variables: |
138 | # c-indentation-style: bsd |
139 | # c-basic-offset: 4 |
140 | # indent-tabs-mode: nil |
141 | # End: |
142 | # vim: expandtab shiftwidth=4: |
143 | |
144 | 1; |