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