summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--INSTALL11
-rw-r--r--Makefile16
-rwxr-xr-xcontrib/examples/git-difftool.perl2
-rwxr-xr-xgit-send-email.perl28
-rw-r--r--gitweb/INSTALL3
-rwxr-xr-xgitweb/gitweb.perl17
-rw-r--r--perl/FromCPAN/.gitattributes1
-rw-r--r--perl/FromCPAN/Error.pm (renamed from perl/Git/FromCPAN/Error.pm)295
-rw-r--r--perl/FromCPAN/Mail/Address.pm (renamed from perl/Git/FromCPAN/Mail/Address.pm)8
-rw-r--r--perl/Git.pm14
-rw-r--r--perl/Git/Error.pm46
-rw-r--r--perl/Git/LoadCPAN.pm104
-rw-r--r--perl/Git/LoadCPAN/Error.pm10
-rw-r--r--perl/Git/LoadCPAN/Mail/Address.pm10
-rwxr-xr-xperl/Git/Mail/Address.pm24
15 files changed, 431 insertions, 158 deletions
diff --git a/INSTALL b/INSTALL
index 808e07b659..60e515eaf7 100644
--- a/INSTALL
+++ b/INSTALL
@@ -88,9 +88,9 @@ Issues of note:
export GIT_EXEC_PATH PATH GITPERLLIB
- By default (unless NO_PERL is provided) Git will ship various perl
- scripts & libraries it needs. However, for simplicity it doesn't
- use the ExtUtils::MakeMaker toolchain to decide where to place the
- perl libraries. Depending on the system this can result in the perl
+ scripts. However, for simplicity it doesn't use the
+ ExtUtils::MakeMaker toolchain to decide where to place the perl
+ libraries. Depending on the system this can result in the perl
libraries not being where you'd like them if they're expected to be
used by things other than Git itself.
@@ -102,6 +102,11 @@ Issues of note:
Will result in e.g. perllibdir=/usr/share/perl/5.26.1 on Debian,
perllibdir=/usr/share/perl5 (which we'd use by default) on CentOS.
+ - Unless NO_PERL is provided Git will ship various perl libraries it
+ needs. Distributors of Git will usually want to set
+ NO_PERL_CPAN_FALLBACKS if NO_PERL is not provided to use their own
+ copies of the CPAN modules Git needs.
+
- Git is reasonably self-sufficient, but does depend on a few external
programs and libraries. Git can be used without most of them by adding
the approriate "NO_<LIBRARY>=YesPlease" to the make command line or
diff --git a/Makefile b/Makefile
index de4b8f0c02..a1d8775adb 100644
--- a/Makefile
+++ b/Makefile
@@ -296,6 +296,12 @@ all::
#
# Define NO_PERL if you do not want Perl scripts or libraries at all.
#
+# Define NO_PERL_CPAN_FALLBACKS if you do not want to install bundled
+# copies of CPAN modules that serve as a fallback in case the modules
+# are not available on the system. This option is intended for
+# distributions that want to use their packaged versions of Perl
+# modules, instead of the fallbacks shipped with Git.
+#
# Define PYTHON_PATH to the path of your Python binary (often /usr/bin/python
# but /usr/bin/python2.7 on some platforms).
#
@@ -2304,14 +2310,22 @@ po/build/locale/%/LC_MESSAGES/git.mo: po/%.po
LIB_PERL := $(wildcard perl/Git.pm perl/Git/*.pm perl/Git/*/*.pm perl/Git/*/*/*.pm)
LIB_PERL_GEN := $(patsubst perl/%.pm,perl/build/lib/%.pm,$(LIB_PERL))
+LIB_CPAN := $(wildcard perl/FromCPAN/*.pm perl/FromCPAN/*/*.pm)
+LIB_CPAN_GEN := $(patsubst perl/%.pm,perl/build/lib/%.pm,$(LIB_CPAN))
ifndef NO_PERL
all:: $(LIB_PERL_GEN)
+ifndef NO_PERL_CPAN_FALLBACKS
+all:: $(LIB_CPAN_GEN)
+endif
+NO_PERL_CPAN_FALLBACKS_SQ = $(subst ','\'',$(NO_PERL_CPAN_FALLBACKS))
endif
perl/build/lib/%.pm: perl/%.pm
$(QUIET_GEN)mkdir -p $(dir $@) && \
- sed -e 's|@@LOCALEDIR@@|$(localedir_SQ)|g' < $< > $@
+ sed -e 's|@@LOCALEDIR@@|$(localedir_SQ)|g' \
+ -e 's|@@NO_PERL_CPAN_FALLBACKS@@|$(NO_PERL_CPAN_FALLBACKS_SQ)|g' \
+ < $< > $@
perl/build/man/man3/Git.3pm: perl/Git.pm
$(QUIET_GEN)mkdir -p $(dir $@) && \
diff --git a/contrib/examples/git-difftool.perl b/contrib/examples/git-difftool.perl
index fb0fd0b84b..b2ea80f9ed 100755
--- a/contrib/examples/git-difftool.perl
+++ b/contrib/examples/git-difftool.perl
@@ -13,7 +13,7 @@
use 5.008;
use strict;
use warnings;
-use Git::Error qw(:try);
+use Git::LoadCPAN::Error qw(:try);
use File::Basename qw(dirname);
use File::Copy;
use File::Find;
diff --git a/git-send-email.perl b/git-send-email.perl
index 3a68aae060..2fa7818ca9 100755
--- a/git-send-email.perl
+++ b/git-send-email.perl
@@ -26,11 +26,13 @@ use Text::ParseWords;
use Term::ANSIColor;
use File::Temp qw/ tempdir tempfile /;
use File::Spec::Functions qw(catdir catfile);
-use Git::Error qw(:try);
+use Git::LoadCPAN::Error qw(:try);
use Cwd qw(abs_path cwd);
use Git;
use Git::I18N;
-use Git::Mail::Address;
+use Net::Domain ();
+use Net::SMTP ();
+use Git::LoadCPAN::Mail::Address;
Getopt::Long::Configure qw/ pass_through /;
@@ -1199,10 +1201,8 @@ sub valid_fqdn {
sub maildomain_net {
my $maildomain;
- if (eval { require Net::Domain; 1 }) {
- my $domain = Net::Domain::domainname();
- $maildomain = $domain if valid_fqdn($domain);
- }
+ my $domain = Net::Domain::domainname();
+ $maildomain = $domain if valid_fqdn($domain);
return $maildomain;
}
@@ -1210,17 +1210,15 @@ sub maildomain_net {
sub maildomain_mta {
my $maildomain;
- if (eval { require Net::SMTP; 1 }) {
- for my $host (qw(mailhost localhost)) {
- my $smtp = Net::SMTP->new($host);
- if (defined $smtp) {
- my $domain = $smtp->domain;
- $smtp->quit;
+ for my $host (qw(mailhost localhost)) {
+ my $smtp = Net::SMTP->new($host);
+ if (defined $smtp) {
+ my $domain = $smtp->domain;
+ $smtp->quit;
- $maildomain = $domain if valid_fqdn($domain);
+ $maildomain = $domain if valid_fqdn($domain);
- last if $maildomain;
- }
+ last if $maildomain;
}
}
diff --git a/gitweb/INSTALL b/gitweb/INSTALL
index 408f2859d3..a58e6b3c44 100644
--- a/gitweb/INSTALL
+++ b/gitweb/INSTALL
@@ -29,12 +29,11 @@ Requirements
------------
- Core git tools
- - Perl
+ - Perl 5.8
- Perl modules: CGI, Encode, Fcntl, File::Find, File::Basename.
- web server
The following optional Perl modules are required for extra features
- - Digest::MD5 - for gravatar support
- CGI::Fast and FCGI - for running gitweb as FastCGI script
- HTML::TagCloud - for fancy tag cloud in project list view
- HTTP::Date or Time::ParseDate - to support If-Modified-Since for feeds
diff --git a/gitweb/gitweb.perl b/gitweb/gitweb.perl
index 2417057f2b..2594a4badb 100755
--- a/gitweb/gitweb.perl
+++ b/gitweb/gitweb.perl
@@ -20,6 +20,8 @@ use Fcntl ':mode';
use File::Find qw();
use File::Basename qw(basename);
use Time::HiRes qw(gettimeofday tv_interval);
+use Digest::MD5 qw(md5_hex);
+
binmode STDOUT, ':utf8';
if (!defined($CGI::VERSION) || $CGI::VERSION < 4.08) {
@@ -490,7 +492,6 @@ our %feature = (
# Currently available providers are gravatar and picon.
# If an unknown provider is specified, the feature is disabled.
- # Gravatar depends on Digest::MD5.
# Picon currently relies on the indiana.edu database.
# To enable system wide have in $GITWEB_CONFIG
@@ -1166,18 +1167,8 @@ sub configure_gitweb_features {
our @snapshot_fmts = gitweb_get_feature('snapshot');
@snapshot_fmts = filter_snapshot_fmts(@snapshot_fmts);
- # check that the avatar feature is set to a known provider name,
- # and for each provider check if the dependencies are satisfied.
- # if the provider name is invalid or the dependencies are not met,
- # reset $git_avatar to the empty string.
our ($git_avatar) = gitweb_get_feature('avatar');
- if ($git_avatar eq 'gravatar') {
- $git_avatar = '' unless (eval { require Digest::MD5; 1; });
- } elsif ($git_avatar eq 'picon') {
- # no dependencies
- } else {
- $git_avatar = '';
- }
+ $git_avatar = '' unless $git_avatar =~ /^(?:gravatar|picon)$/s;
our @extra_branch_refs = gitweb_get_feature('extra-branch-refs');
@extra_branch_refs = filter_and_validate_refs (@extra_branch_refs);
@@ -2167,7 +2158,7 @@ sub gravatar_url {
my $size = shift;
$avatar_cache{$email} ||=
"//www.gravatar.com/avatar/" .
- Digest::MD5::md5_hex($email) . "?s=";
+ md5_hex($email) . "?s=";
return $avatar_cache{$email} . $size;
}
diff --git a/perl/FromCPAN/.gitattributes b/perl/FromCPAN/.gitattributes
new file mode 100644
index 0000000000..8b64fc5e22
--- /dev/null
+++ b/perl/FromCPAN/.gitattributes
@@ -0,0 +1 @@
+/Error.pm whitespace=-blank-at-eof
diff --git a/perl/Git/FromCPAN/Error.pm b/perl/FromCPAN/Error.pm
index 6098135ae2..8b95e2d73d 100644
--- a/perl/Git/FromCPAN/Error.pm
+++ b/perl/FromCPAN/Error.pm
@@ -12,10 +12,12 @@
package Error;
use strict;
+use warnings;
+
use vars qw($VERSION);
use 5.004;
-$VERSION = "0.15009";
+$VERSION = "0.17025";
use overload (
'""' => 'stringify',
@@ -32,21 +34,35 @@ $Error::THROWN = undef; # last error thrown, a workaround until die $ref works
my $LAST; # Last error created
my %ERROR; # Last error associated with package
-sub throw_Error_Simple
+sub _throw_Error_Simple
{
my $args = shift;
return Error::Simple->new($args->{'text'});
}
-$Error::ObjectifyCallback = \&throw_Error_Simple;
+$Error::ObjectifyCallback = \&_throw_Error_Simple;
# Exported subs are defined in Error::subs
+use Scalar::Util ();
+
sub import {
shift;
+ my @tags = @_;
local $Exporter::ExportLevel = $Exporter::ExportLevel + 1;
- Error::subs->import(@_);
+
+ @tags = grep {
+ if( $_ eq ':warndie' ) {
+ Error::WarnDie->import();
+ 0;
+ }
+ else {
+ 1;
+ }
+ } @tags;
+
+ Error::subs->import(@tags);
}
# I really want to use last for the name of this method, but it is a keyword
@@ -107,10 +123,6 @@ sub stacktrace {
$text;
}
-# Allow error propagation, ie
-#
-# $ber->encode(...) or
-# return Error->prior($ber)->associate($ldap);
sub associate {
my $err = shift;
@@ -130,6 +142,7 @@ sub associate {
return;
}
+
sub new {
my $self = shift;
my($pkg,$file,$line) = caller($Error::Depth);
@@ -246,6 +259,10 @@ sub value {
package Error::Simple;
+use vars qw($VERSION);
+
+$VERSION = "0.17025";
+
@Error::Simple::ISA = qw(Error);
sub new {
@@ -288,14 +305,6 @@ use vars qw(@EXPORT_OK @ISA %EXPORT_TAGS);
@ISA = qw(Exporter);
-
-sub blessed {
- my $item = shift;
- local $@; # don't kill an outer $@
- ref $item and eval { $item->can('can') };
-}
-
-
sub run_clauses ($$$\@) {
my($clauses,$err,$wantarray,$result) = @_;
my $code = undef;
@@ -314,16 +323,17 @@ sub run_clauses ($$$\@) {
my $pkg = $catch->[$i];
unless(defined $pkg) {
#except
- splice(@$catch,$i,2,$catch->[$i+1]->());
+ splice(@$catch,$i,2,$catch->[$i+1]->($err));
$i -= 2;
next CATCHLOOP;
}
- elsif(blessed($err) && $err->isa($pkg)) {
+ elsif(Scalar::Util::blessed($err) && $err->isa($pkg)) {
$code = $catch->[$i+1];
while(1) {
my $more = 0;
- local($Error::THROWN);
+ local($Error::THROWN, $@);
my $ok = eval {
+ $@ = $err;
if($wantarray) {
@{$result} = $code->($err,\$more);
}
@@ -341,10 +351,9 @@ sub run_clauses ($$$\@) {
undef $err;
}
else {
- $err = defined($Error::THROWN)
- ? $Error::THROWN : $@;
- $err = $Error::ObjectifyCallback->({'text' =>$err})
- unless ref($err);
+ $err = $@ || $Error::THROWN;
+ $err = $Error::ObjectifyCallback->({'text' =>$err})
+ unless ref($err);
}
last CATCH;
};
@@ -357,7 +366,9 @@ sub run_clauses ($$$\@) {
if(defined($owise = $clauses->{'otherwise'})) {
my $code = $clauses->{'otherwise'};
my $more = 0;
+ local($Error::THROWN, $@);
my $ok = eval {
+ $@ = $err;
if($wantarray) {
@{$result} = $code->($err,\$more);
}
@@ -374,11 +385,10 @@ sub run_clauses ($$$\@) {
undef $err;
}
else {
- $err = defined($Error::THROWN)
- ? $Error::THROWN : $@;
+ $err = $@ || $Error::THROWN;
- $err = $Error::ObjectifyCallback->({'text' =>$err})
- unless ref($err);
+ $err = $Error::ObjectifyCallback->({'text' =>$err})
+ unless ref($err);
}
}
}
@@ -398,7 +408,7 @@ sub try (&;$) {
do {
local $Error::THROWN = undef;
- local $@ = undef;
+ local $@ = undef;
$ok = eval {
if($wantarray) {
@@ -413,21 +423,21 @@ sub try (&;$) {
1;
};
- $err = defined($Error::THROWN) ? $Error::THROWN : $@
+ $err = $@ || $Error::THROWN
unless $ok;
};
shift @Error::STACK;
$err = run_clauses($clauses,$err,wantarray,@result)
- unless($ok);
+ unless($ok);
$clauses->{'finally'}->()
if(defined($clauses->{'finally'}));
if (defined($err))
{
- if (blessed($err) && $err->can('throw'))
+ if (Scalar::Util::blessed($err) && $err->can('throw'))
{
throw $err;
}
@@ -506,12 +516,116 @@ sub otherwise (&;$) {
}
1;
+
+package Error::WarnDie;
+
+sub gen_callstack($)
+{
+ my ( $start ) = @_;
+
+ require Carp;
+ local $Carp::CarpLevel = $start;
+ my $trace = Carp::longmess("");
+ # Remove try calls from the trace
+ $trace =~ s/(\n\s+\S+__ANON__[^\n]+)?\n\s+eval[^\n]+\n\s+Error::subs::try[^\n]+(?=\n)//sog;
+ $trace =~ s/(\n\s+\S+__ANON__[^\n]+)?\n\s+eval[^\n]+\n\s+Error::subs::run_clauses[^\n]+\n\s+Error::subs::try[^\n]+(?=\n)//sog;
+ my @callstack = split( m/\n/, $trace );
+ return @callstack;
+}
+
+my $old_DIE;
+my $old_WARN;
+
+sub DEATH
+{
+ my ( $e ) = @_;
+
+ local $SIG{__DIE__} = $old_DIE if( defined $old_DIE );
+
+ die @_ if $^S;
+
+ my ( $etype, $message, $location, @callstack );
+ if ( ref($e) && $e->isa( "Error" ) ) {
+ $etype = "exception of type " . ref( $e );
+ $message = $e->text;
+ $location = $e->file . ":" . $e->line;
+ @callstack = split( m/\n/, $e->stacktrace );
+ }
+ else {
+ # Don't apply subsequent layer of message formatting
+ die $e if( $e =~ m/^\nUnhandled perl error caught at toplevel:\n\n/ );
+ $etype = "perl error";
+ my $stackdepth = 0;
+ while( caller( $stackdepth ) =~ m/^Error(?:$|::)/ ) {
+ $stackdepth++
+ }
+
+ @callstack = gen_callstack( $stackdepth + 1 );
+
+ $message = "$e";
+ chomp $message;
+
+ if ( $message =~ s/ at (.*?) line (\d+)\.$// ) {
+ $location = $1 . ":" . $2;
+ }
+ else {
+ my @caller = caller( $stackdepth );
+ $location = $caller[1] . ":" . $caller[2];
+ }
+ }
+
+ shift @callstack;
+ # Do it this way in case there are no elements; we don't print a spurious \n
+ my $callstack = join( "", map { "$_\n"} @callstack );
+
+ die "\nUnhandled $etype caught at toplevel:\n\n $message\n\nThrown from: $location\n\nFull stack trace:\n\n$callstack\n";
+}
+
+sub TAXES
+{
+ my ( $message ) = @_;
+
+ local $SIG{__WARN__} = $old_WARN if( defined $old_WARN );
+
+ $message =~ s/ at .*? line \d+\.$//;
+ chomp $message;
+
+ my @callstack = gen_callstack( 1 );
+ my $location = shift @callstack;
+
+ # $location already starts in a leading space
+ $message .= $location;
+
+ # Do it this way in case there are no elements; we don't print a spurious \n
+ my $callstack = join( "", map { "$_\n"} @callstack );
+
+ warn "$message:\n$callstack";
+}
+
+sub import
+{
+ $old_DIE = $SIG{__DIE__};
+ $old_WARN = $SIG{__WARN__};
+
+ $SIG{__DIE__} = \&DEATH;
+ $SIG{__WARN__} = \&TAXES;
+}
+
+1;
+
__END__
=head1 NAME
Error - Error/exception handling in an OO-ish way
+=head1 WARNING
+
+Using the "Error" module is B<no longer recommended> due to the black-magical
+nature of its syntactic sugar, which often tends to break. Its maintainers
+have stopped actively writing code that uses it, and discourage people
+from doing so. See the "SEE ALSO" section below for better recommendations.
+
=head1 SYNOPSIS
use Error qw(:try);
@@ -529,7 +643,7 @@ Error - Error/exception handling in an OO-ish way
try {
do_some_stuff();
die "error!" if $condition;
- throw Error::Simple -text => "Oops!" if $other_condition;
+ throw Error::Simple "Oops!" if $other_condition;
}
catch Error::IO with {
my $E = shift;
@@ -587,7 +701,7 @@ C<BLOCK> will be passed two arguments. The first will be the error
being thrown. The second is a reference to a scalar variable. If this
variable is set by the catch block then, on return from the catch
block, try will continue processing as if the catch block was never
-found.
+found. The error will also be available in C<$@>.
To propagate the error the catch block may call C<$err-E<gt>throw>
@@ -608,7 +722,7 @@ type.
Catch any error by executing the code in C<BLOCK>
When evaluated C<BLOCK> will be passed one argument, which will be the
-error being processed.
+error being processed. The error will also be available in C<$@>.
Only one otherwise block may be specified per try block
@@ -625,12 +739,25 @@ Only one finally block may be specified per try block
=back
+=head1 COMPATIBILITY
+
+L<Moose> exports a keyword called C<with> which clashes with Error's. This
+example returns a prototype mismatch error:
+
+ package MyTest;
+
+ use warnings;
+ use Moose;
+ use Error qw(:try);
+
+(Thanks to C<maik.hentsche@amd.com> for the report.).
+
=head1 CLASS INTERFACE
=head2 CONSTRUCTORS
The C<Error> object is implemented as a HASH. This HASH is initialized
-with the arguments that are passed to its constructor. The elements
+with the arguments that are passed to it's constructor. The elements
that are used by, or are retrievable by the C<Error> class are listed
below, other classes may add to these.
@@ -655,6 +782,10 @@ an object blessed into that package as the C<-object> argument.
=over 4
+=item Error->new()
+
+See the Error::Simple documentation.
+
=item throw ( [ ARGS ] )
Create a new C<Error> object and throw an error, which will be caught
@@ -730,6 +861,13 @@ The line where the constructor of this error was called from
The text of the error
+=item $err->associate($obj)
+
+Associates an error with an object to allow error propagation. I.e:
+
+ $ber->encode(...) or
+ return Error->prior($ber)->associate($ldap);
+
=back
=head2 OVERLOAD METHODS
@@ -759,11 +897,9 @@ to the constructor.
=head1 PRE-DEFINED ERROR CLASSES
-=over 4
-
-=item Error::Simple
+=head2 Error::Simple
-This class can be used to hold simple error strings and values. Its
+This class can be used to hold simple error strings and values. It's
constructor takes two arguments. The first is a text value, the second
is a numeric value. These values are what will be returned by the
overload methods.
@@ -775,7 +911,6 @@ of the error object.
This class is used internally if an eval'd block die's with an error
that is a plain string. (Unless C<$Error::ObjectifyCallback> is modified)
-=back
=head1 $Error::ObjectifyCallback
@@ -804,6 +939,76 @@ class MyError::Bar by default:
# Error handling here.
}
+=cut
+
+=head1 MESSAGE HANDLERS
+
+C<Error> also provides handlers to extend the output of the C<warn()> perl
+function, and to handle the printing of a thrown C<Error> that is not caught
+or otherwise handled. These are not installed by default, but are requested
+using the C<:warndie> tag in the C<use> line.
+
+ use Error qw( :warndie );
+
+These new error handlers are installed in C<$SIG{__WARN__}> and
+C<$SIG{__DIE__}>. If these handlers are already defined when the tag is
+imported, the old values are stored, and used during the new code. Thus, to
+arrange for custom handling of warnings and errors, you will need to perform
+something like the following:
+
+ BEGIN {
+ $SIG{__WARN__} = sub {
+ print STDERR "My special warning handler: $_[0]"
+ };
+ }
+
+ use Error qw( :warndie );
+
+Note that setting C<$SIG{__WARN__}> after the C<:warndie> tag has been
+imported will overwrite the handler that C<Error> provides. If this cannot be
+avoided, then the tag can be explicitly C<import>ed later
+
+ use Error;
+
+ $SIG{__WARN__} = ...;
+
+ import Error qw( :warndie );
+
+=head2 EXAMPLE
+
+The C<__DIE__> handler turns messages such as
+
+ Can't call method "foo" on an undefined value at examples/warndie.pl line 16.
+
+into
+
+ Unhandled perl error caught at toplevel:
+
+ Can't call method "foo" on an undefined value
+
+ Thrown from: examples/warndie.pl:16
+
+ Full stack trace:
+
+ main::inner('undef') called at examples/warndie.pl line 20
+ main::outer('undef') called at examples/warndie.pl line 23
+
+=cut
+
+=head1 SEE ALSO
+
+See L<Exception::Class> for a different module providing Object-Oriented
+exception handling, along with a convenient syntax for declaring hierarchies
+for them. It doesn't provide Error's syntactic sugar of C<try { ... }>,
+C<catch { ... }>, etc. which may be a good thing or a bad thing based
+on what you want. (Because Error's syntactic sugar tends to break.)
+
+L<Error::Exception> aims to combine L<Error> and L<Exception::Class>
+"with correct stringification".
+
+L<TryCatch> and L<Try::Tiny> are similar in concept to Error.pm only providing
+a syntax that hopefully breaks less.
+
=head1 KNOWN BUGS
None, but that does not mean there are not any.
@@ -816,12 +1021,20 @@ The code that inspired me to write this was originally written by
Peter Seibel <peter@weblogic.com> and adapted by Jesse Glick
<jglick@sig.bsh.com>.
+C<:warndie> handlers added by Paul Evans <leonerd@leonerd.org.uk>
+
=head1 MAINTAINER
-Shlomi Fish <shlomif@iglu.org.il>
+Shlomi Fish, L<http://www.shlomifish.org/> .
=head1 PAST MAINTAINERS
Arun Kumar U <u_arunkumar@yahoo.com>
+=head1 COPYRIGHT
+
+Copyright (c) 1997-8 Graham Barr. All rights reserved.
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
=cut
diff --git a/perl/Git/FromCPAN/Mail/Address.pm b/perl/FromCPAN/Mail/Address.pm
index 13b2ff7d05..683d490b2b 100644
--- a/perl/Git/FromCPAN/Mail/Address.pm
+++ b/perl/FromCPAN/Mail/Address.pm
@@ -1,10 +1,14 @@
-# Copyrights 1995-2017 by [Mark Overmeer <perl@overmeer.net>].
+# Copyrights 1995-2018 by [Mark Overmeer].
# For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.02.
+# This code is part of the bundle MailTools. Meta-POD processed with
+# OODoc into POD and HTML manual-pages. See README.md for Copyright.
+# Licensed under the same terms as Perl itself.
+
package Mail::Address;
use vars '$VERSION';
-$VERSION = '2.19';
+$VERSION = '2.20';
use strict;
diff --git a/perl/Git.pm b/perl/Git.pm
index a7440a1f09..16ebcc612c 100644
--- a/perl/Git.pm
+++ b/perl/Git.pm
@@ -9,7 +9,10 @@ package Git;
use 5.008;
use strict;
+use warnings;
+use File::Temp ();
+use File::Spec ();
BEGIN {
@@ -101,7 +104,7 @@ increase notwithstanding).
use Carp qw(carp croak); # but croak is bad - throw instead
-use Git::Error qw(:try);
+use Git::LoadCPAN::Error qw(:try);
use Cwd qw(abs_path cwd);
use IPC::Open2 qw(open2);
use Fcntl qw(SEEK_SET SEEK_CUR);
@@ -189,7 +192,6 @@ sub repository {
};
if ($dir) {
- _verify_require();
File::Spec->file_name_is_absolute($dir) or $dir = $opts{Directory} . '/' . $dir;
$opts{Repository} = abs_path($dir);
@@ -1290,8 +1292,6 @@ sub temp_release {
sub _temp_cache {
my ($self, $name) = _maybe_self(@_);
- _verify_require();
-
my $temp_fd = \$TEMP_FILEMAP{$name};
if (defined $$temp_fd and $$temp_fd->opened) {
if ($TEMP_FILES{$$temp_fd}{locked}) {
@@ -1325,11 +1325,6 @@ sub _temp_cache {
$$temp_fd;
}
-sub _verify_require {
- eval { require File::Temp; require File::Spec; };
- $@ and throw Error::Simple($@);
-}
-
=item temp_reset ( FILEHANDLE )
Truncates and resets the position of the C<FILEHANDLE>.
@@ -1694,7 +1689,6 @@ sub DESTROY {
# Pipe implementation for ActiveState Perl.
package Git::activestate_pipe;
-use strict;
sub TIEHANDLE {
my ($class, @params) = @_;
diff --git a/perl/Git/Error.pm b/perl/Git/Error.pm
deleted file mode 100644
index 09bbc97390..0000000000
--- a/perl/Git/Error.pm
+++ /dev/null
@@ -1,46 +0,0 @@
-package Git::Error;
-use 5.008;
-use strict;
-use warnings;
-
-=head1 NAME
-
-Git::Error - Wrapper for the L<Error> module, in case it's not installed
-
-=head1 DESCRIPTION
-
-Wraps the import function for the L<Error> module.
-
-This module is only intended to be used for code shipping in the
-C<git.git> repository. Use it for anything else at your peril!
-
-=cut
-
-sub import {
- shift;
- my $caller = caller;
-
- eval {
- require Error;
- 1;
- } or do {
- my $error = $@ || "Zombie Error";
-
- my $Git_Error_pm_path = $INC{"Git/Error.pm"} || die "BUG: Should have our own path from %INC!";
-
- require File::Basename;
- my $Git_Error_pm_root = File::Basename::dirname($Git_Error_pm_path) || die "BUG: Can't figure out lib/Git dirname from '$Git_Error_pm_path'!";
-
- require File::Spec;
- my $Git_pm_FromCPAN_root = File::Spec->catdir($Git_Error_pm_root, 'FromCPAN');
- die "BUG: '$Git_pm_FromCPAN_root' should be a directory!" unless -d $Git_pm_FromCPAN_root;
-
- local @INC = ($Git_pm_FromCPAN_root, @INC);
- require Error;
- };
-
- unshift @_, $caller;
- goto &Error::import;
-}
-
-1;
diff --git a/perl/Git/LoadCPAN.pm b/perl/Git/LoadCPAN.pm
new file mode 100644
index 0000000000..e5585e75e8
--- /dev/null
+++ b/perl/Git/LoadCPAN.pm
@@ -0,0 +1,104 @@
+package Git::LoadCPAN;
+use 5.008;
+use strict;
+use warnings;
+
+=head1 NAME
+
+Git::LoadCPAN - Wrapper for loading modules from the CPAN (OS) or Git's own copy
+
+=head1 DESCRIPTION
+
+The Perl code in Git depends on some modules from the CPAN, but we
+don't want to make those a hard requirement for anyone building from
+source.
+
+Therefore the L<Git::LoadCPAN> namespace shipped with Git contains
+wrapper modules like C<Git::LoadCPAN::Module::Name> that will first
+attempt to load C<Module::Name> from the OS, and if that doesn't work
+will fall back on C<FromCPAN::Module::Name> shipped with Git itself.
+
+Usually distributors will not ship with Git's Git::FromCPAN tree at
+all via the C<NO_PERL_CPAN_FALLBACKS> option, preferring to use their
+own packaging of CPAN modules instead.
+
+This module is only intended to be used for code shipping in the
+C<git.git> repository. Use it for anything else at your peril!
+
+=cut
+
+# NO_PERL_CPAN_FALLBACKS_STR evades the sed search-replace from the
+# Makefile, and allows for detecting whether the module is loaded from
+# perl/Git as opposed to perl/build/Git, which is useful for one-off
+# testing without having Error.pm et al installed.
+use constant NO_PERL_CPAN_FALLBACKS_STR => '@@' . 'NO_PERL_CPAN_FALLBACKS' . '@@';
+use constant NO_PERL_CPAN_FALLBACKS => (
+ q[@@NO_PERL_CPAN_FALLBACKS@@] ne ''
+ and
+ q[@@NO_PERL_CPAN_FALLBACKS@@] ne NO_PERL_CPAN_FALLBACKS_STR
+);
+
+sub import {
+ shift;
+ my $caller = caller;
+ my %args = @_;
+ my $module = exists $args{module} ? delete $args{module} : die "BUG: Expected 'module' parameter!";
+ my $import = exists $args{import} ? delete $args{import} : die "BUG: Expected 'import' parameter!";
+ die "BUG: Too many arguments!" if keys %args;
+
+ # Foo::Bar to Foo/Bar.pm
+ my $package_pm = $module;
+ $package_pm =~ s[::][/]g;
+ $package_pm .= '.pm';
+
+ eval {
+ require $package_pm;
+ 1;
+ } or do {
+ my $error = $@ || "Zombie Error";
+
+ if (NO_PERL_CPAN_FALLBACKS) {
+ chomp(my $error = sprintf <<'THEY_PROMISED', $module);
+BUG: The '%s' module is not here, but NO_PERL_CPAN_FALLBACKS was set!
+
+Git needs this Perl module from the CPAN, and will by default ship
+with a copy of it. This Git was built with NO_PERL_CPAN_FALLBACKS,
+meaning that whoever built it promised to provide this module.
+
+You're seeing this error because they broke that promise, and we can't
+load our fallback version, since we were asked not to install it.
+
+If you're seeing this error and didn't package Git yourself the
+package you're using is broken, or your system is broken. This error
+won't appear if Git is built without NO_PERL_CPAN_FALLBACKS (instead
+we'll use our fallback version of the module).
+THEY_PROMISED
+ die $error;
+ }
+
+ my $Git_LoadCPAN_pm_path = $INC{"Git/LoadCPAN.pm"} || die "BUG: Should have our own path from %INC!";
+
+ require File::Basename;
+ 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'!";
+
+ require File::Spec;
+ my $Git_pm_FromCPAN_root = File::Spec->catdir($Git_LoadCPAN_pm_root, '..', 'FromCPAN');
+ die "BUG: '$Git_pm_FromCPAN_root' should be a directory!" unless -d $Git_pm_FromCPAN_root;
+
+ local @INC = ($Git_pm_FromCPAN_root, @INC);
+ require $package_pm;
+ };
+
+ if ($import) {
+ no strict 'refs';
+ *{"${caller}::import"} = sub {
+ shift;
+ use strict 'refs';
+ unshift @_, $module;
+ goto &{"${module}::import"};
+ };
+ use strict 'refs';
+ }
+}
+
+1;
diff --git a/perl/Git/LoadCPAN/Error.pm b/perl/Git/LoadCPAN/Error.pm
new file mode 100644
index 0000000000..c6d2c45d80
--- /dev/null
+++ b/perl/Git/LoadCPAN/Error.pm
@@ -0,0 +1,10 @@
+package Git::LoadCPAN::Error;
+use 5.008;
+use strict;
+use warnings;
+use Git::LoadCPAN (
+ module => 'Error',
+ import => 1,
+);
+
+1;
diff --git a/perl/Git/LoadCPAN/Mail/Address.pm b/perl/Git/LoadCPAN/Mail/Address.pm
new file mode 100644
index 0000000000..f70a4f064c
--- /dev/null
+++ b/perl/Git/LoadCPAN/Mail/Address.pm
@@ -0,0 +1,10 @@
+package Git::LoadCPAN::Mail::Address;
+use 5.008;
+use strict;
+use warnings;
+use Git::LoadCPAN (
+ module => 'Mail::Address',
+ import => 0,
+);
+
+1;
diff --git a/perl/Git/Mail/Address.pm b/perl/Git/Mail/Address.pm
deleted file mode 100755
index 2ce3e84670..0000000000
--- a/perl/Git/Mail/Address.pm
+++ /dev/null
@@ -1,24 +0,0 @@
-package Git::Mail::Address;
-use 5.008;
-use strict;
-use warnings;
-
-=head1 NAME
-
-Git::Mail::Address - Wrapper for the L<Mail::Address> module, in case it's not installed
-
-=head1 DESCRIPTION
-
-This module is only intended to be used for code shipping in the
-C<git.git> repository. Use it for anything else at your peril!
-
-=cut
-
-eval {
- require Mail::Address;
- 1;
-} or do {
- require Git::FromCPAN::Mail::Address;
-};
-
-1;
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-25 13:10:50 +0000