PageRenderTime 38ms CodeModel.GetById 11ms RepoModel.GetById 1ms app.codeStats 0ms

/perl/Git/LoadCPAN.pm

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