| 1 | package Git::LoadCPAN; |
| 2 | require v5.26; |
| 3 | use strict; |
| 4 | use warnings $ENV{GIT_PERL_FATAL_WARNINGS} ? qw(FATAL all) : (); |
| 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 |
| 19 | will fall back on C<FromCPAN::Module::Name> shipped with Git itself. |
| 20 | |
| 21 | Usually distributors will not ship with Git's Git::FromCPAN tree at |
| 22 | all via the C<NO_PERL_CPAN_FALLBACKS> option, preferring to use their |
| 23 | own packaging of CPAN modules instead. |
| 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 | |
| 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 | |
| 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 | |
| 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 | |
| 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; |
| 85 | my $Git_pm_FromCPAN_root = File::Spec->catdir($Git_LoadCPAN_pm_root, '..', 'FromCPAN'); |
| 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; |