Commit | Line | Data |
613f422f |
1 | package inc::latest::private; |
2 | use strict; |
3 | use vars qw($VERSION); |
7dc9e1b4 |
4 | $VERSION = '0.3603'; |
613f422f |
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"; |
53fc1c7e |
24 | |
613f422f |
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); |
53fc1c7e |
69 | |
613f422f |
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 | |