]>
Commit | Line | Data |
---|---|---|
edfb7b92 ÆAB |
1 | package Git::LoadCPAN; |
2 | use 5.008; | |
3 | use strict; | |
4 | use warnings; | |
5 | ||
6 | =head1 NAME | |
7 | ||
8 | Git::LoadCPAN - Wrapper for loading modules from the CPAN (OS) or Git's own copy | |
9 | ||
10 | =head1 DESCRIPTION | |
11 | ||
12 | The Perl code in Git depends on some modules from the CPAN, but we | |
13 | don't want to make those a hard requirement for anyone building from | |
14 | source. | |
15 | ||
16 | Therefore the L<Git::LoadCPAN> namespace shipped with Git contains | |
17 | wrapper modules like C<Git::LoadCPAN::Module::Name> that will first | |
18 | attempt to load C<Module::Name> from the OS, and if that doesn't work | |
382029fc | 19 | will fall back on C<FromCPAN::Module::Name> shipped with Git itself. |
edfb7b92 ÆAB |
20 | |
21 | Usually distributors will not ship with Git's Git::FromCPAN tree at | |
1aca69c0 ÆAB |
22 | all via the C<NO_PERL_CPAN_FALLBACKS> option, preferring to use their |
23 | own packaging of CPAN modules instead. | |
edfb7b92 ÆAB |
24 | |
25 | This module is only intended to be used for code shipping in the | |
26 | C<git.git> repository. Use it for anything else at your peril! | |
27 | ||
28 | =cut | |
29 | ||
1aca69c0 ÆAB |
30 | # NO_PERL_CPAN_FALLBACKS_STR evades the sed search-replace from the |
31 | # Makefile, and allows for detecting whether the module is loaded from | |
32 | # perl/Git as opposed to perl/build/Git, which is useful for one-off | |
33 | # testing without having Error.pm et al installed. | |
34 | use constant NO_PERL_CPAN_FALLBACKS_STR => '@@' . 'NO_PERL_CPAN_FALLBACKS' . '@@'; | |
35 | use constant NO_PERL_CPAN_FALLBACKS => ( | |
36 | q[@@NO_PERL_CPAN_FALLBACKS@@] ne '' | |
37 | and | |
38 | q[@@NO_PERL_CPAN_FALLBACKS@@] ne NO_PERL_CPAN_FALLBACKS_STR | |
39 | ); | |
40 | ||
edfb7b92 ÆAB |
41 | sub import { |
42 | shift; | |
43 | my $caller = caller; | |
44 | my %args = @_; | |
45 | my $module = exists $args{module} ? delete $args{module} : die "BUG: Expected 'module' parameter!"; | |
46 | my $import = exists $args{import} ? delete $args{import} : die "BUG: Expected 'import' parameter!"; | |
47 | die "BUG: Too many arguments!" if keys %args; | |
48 | ||
49 | # Foo::Bar to Foo/Bar.pm | |
50 | my $package_pm = $module; | |
51 | $package_pm =~ s[::][/]g; | |
52 | $package_pm .= '.pm'; | |
53 | ||
54 | eval { | |
55 | require $package_pm; | |
56 | 1; | |
57 | } or do { | |
58 | my $error = $@ || "Zombie Error"; | |
59 | ||
1aca69c0 ÆAB |
60 | if (NO_PERL_CPAN_FALLBACKS) { |
61 | chomp(my $error = sprintf <<'THEY_PROMISED', $module); | |
62 | BUG: The '%s' module is not here, but NO_PERL_CPAN_FALLBACKS was set! | |
63 | ||
64 | Git needs this Perl module from the CPAN, and will by default ship | |
65 | with a copy of it. This Git was built with NO_PERL_CPAN_FALLBACKS, | |
66 | meaning that whoever built it promised to provide this module. | |
67 | ||
68 | You're seeing this error because they broke that promise, and we can't | |
69 | load our fallback version, since we were asked not to install it. | |
70 | ||
71 | If you're seeing this error and didn't package Git yourself the | |
72 | package you're using is broken, or your system is broken. This error | |
73 | won't appear if Git is built without NO_PERL_CPAN_FALLBACKS (instead | |
74 | we'll use our fallback version of the module). | |
75 | THEY_PROMISED | |
76 | die $error; | |
77 | } | |
78 | ||
edfb7b92 ÆAB |
79 | my $Git_LoadCPAN_pm_path = $INC{"Git/LoadCPAN.pm"} || die "BUG: Should have our own path from %INC!"; |
80 | ||
81 | require File::Basename; | |
82 | my $Git_LoadCPAN_pm_root = File::Basename::dirname($Git_LoadCPAN_pm_path) || die "BUG: Can't figure out lib/Git dirname from '$Git_LoadCPAN_pm_path'!"; | |
83 | ||
84 | require File::Spec; | |
382029fc | 85 | my $Git_pm_FromCPAN_root = File::Spec->catdir($Git_LoadCPAN_pm_root, '..', 'FromCPAN'); |
edfb7b92 ÆAB |
86 | die "BUG: '$Git_pm_FromCPAN_root' should be a directory!" unless -d $Git_pm_FromCPAN_root; |
87 | ||
88 | local @INC = ($Git_pm_FromCPAN_root, @INC); | |
89 | require $package_pm; | |
90 | }; | |
91 | ||
92 | if ($import) { | |
93 | no strict 'refs'; | |
94 | *{"${caller}::import"} = sub { | |
95 | shift; | |
96 | use strict 'refs'; | |
97 | unshift @_, $module; | |
98 | goto &{"${module}::import"}; | |
99 | }; | |
100 | use strict 'refs'; | |
101 | } | |
102 | } | |
103 | ||
104 | 1; |