This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update Module-Build to CPAN version 0.4204
[perl5.git] / cpan / Module-Build / lib / inc / latest / private.pm
CommitLineData
613f422f 1package inc::latest::private;
46de787b
CBW
2
3use if $] >= 5.019, 'deprecate';
4
613f422f
DG
5use strict;
6use vars qw($VERSION);
71213e49 7$VERSION = '0.4204';
613f422f
DG
8$VERSION = eval $VERSION;
9
10use File::Spec;
613f422f
DG
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.
14sub 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";
53fc1c7e 26
613f422f
DG
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
44sub _version {
45 require ExtUtils::MakeMaker;
46 return ExtUtils::MM->parse_version(shift);
47}
48
49# use "goto" for import to preserve caller
50sub _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
60sub _search_bundled {
61 my ($self, $file) = @_;
62
63 my $mypath = 'inc';
64
46de787b 65 opendir my $DH, $mypath or die "Can't open directory $mypath: $!";
613f422f 66
46de787b 67 while (defined(my $e = readdir $DH)) {
613f422f
DG
68 next unless $e =~ /^inc_/;
69 my $try = File::Spec->catfile($mypath, $e, $file);
53fc1c7e 70
613f422f
DG
71 return($try, File::Spec->catdir($mypath, $e)) if -e $try;
72 }
73 return;
74}
75
76# Look for the given path in @INC.
77sub _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
92sub _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
1001;
101
102