[Summary view] [Print] [Text view]

   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;