cpan/Module-Build/lib/inc/latest/private.pm

   1 package inc::latest::private;
   2 use strict;
   3 use vars qw($VERSION);
   4 $VERSION = '0.4005';
   5 $VERSION = eval $VERSION;
   6
   7 use File::Spec;
   8 use IO::File;
   9
  10 # must ultimately "goto" the import routine of the module to be loaded
  11 # so that the calling package is correct when $mod->import() runs.
  12 sub import {
  13   my ($package, $mod, @args) = @_;
  14   my $file = $package->_mod2path($mod);
  15
  16   if ($INC{$file}) {
  17     # Already loaded, but let _load_module handle import args
  18     goto \&_load_module;
  19   }
  20
  21   # A bundled copy must be present
  22   my ($bundled, $bundled_dir) = $package->_search_bundled($file)
  23     or die "No bundled copy of $mod found";
  24
  25   my $from_inc = $package->_search_INC($file);
  26   unless ($from_inc) {
  27     # Only bundled is available
  28     unshift(@INC, $bundled_dir);
  29     goto \&_load_module;
  30   }
  31
  32   if (_version($from_inc) >= _version($bundled)) {
  33     # Ignore the bundled copy
  34     goto \&_load_module;
  35   }
  36
  37   # Load the bundled copy
  38   unshift(@INC, $bundled_dir);
  39   goto \&_load_module;
  40 }
  41
  42 sub _version {
  43   require ExtUtils::MakeMaker;
  44   return ExtUtils::MM->parse_version(shift);
  45 }
  46
  47 # use "goto" for import to preserve caller
  48 sub _load_module {
  49   my $package = shift; # remaining @_ is ready for goto
  50   my ($mod, @args) = @_;
  51   eval "require $mod; 1" or die $@;
  52   if ( my $import = $mod->can('import') ) {
  53     goto $import;
  54   }
  55   return 1;
  56 }
  57
  58 sub _search_bundled {
  59   my ($self, $file) = @_;
  60
  61   my $mypath = 'inc';
  62
  63   local *DH;   # Maintain 5.005 compatibility
  64   opendir DH, $mypath or die "Can't open directory $mypath: $!";
  65
  66   while (defined(my $e = readdir DH)) {
  67     next unless $e =~ /^inc_/;
  68     my $try = File::Spec->catfile($mypath, $e, $file);
  69
  70     return($try, File::Spec->catdir($mypath, $e)) if -e $try;
  71   }
  72   return;
  73 }
  74
  75 # Look for the given path in @INC.
  76 sub _search_INC {
  77   # TODO: doesn't handle coderefs or arrayrefs or objects in @INC, but
  78   # it probably should
  79   my ($self, $file) = @_;
  80
  81   foreach my $dir (@INC) {
  82     next if ref $dir;
  83     my $try = File::Spec->catfile($dir, $file);
  84     return $try if -e $try;
  85   }
  86
  87   return;
  88 }
  89
  90 # Translate a module name into a directory/file.pm to search for in @INC
  91 sub _mod2path {
  92   my ($self, $mod) = @_;
  93   my @parts = split /::/, $mod;
  94   $parts[-1] .= '.pm';
  95   return $parts[0] if @parts == 1;
  96   return File::Spec->catfile(@parts);
  97 }
  98
  99 1;
 100
 101