Initial Commit

database/perl/lib/Module/Loaded.pm

@@ -0,0 +1,142 @@
+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;