80772594eddc1f47c3d053f1240df3f38bd63659
[perl.git] / cpan / Module-Build / lib / inc / latest / private.pm
1 package inc::latest::private;
2 use strict;
3 use vars qw($VERSION);
4 $VERSION = '0.37_05';
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