Merge branch 'ab/perl-fixes'

Clean-up to various pieces of Perl code we have.

* ab/perl-fixes:
  perl Git::LoadCPAN: emit better errors under NO_PERL_CPAN_FALLBACKS
  Makefile: add NO_PERL_CPAN_FALLBACKS knob
  perl: move the perl/Git/FromCPAN tree to perl/FromCPAN
  perl: generalize the Git::LoadCPAN facility
  perl: move CPAN loader wrappers to another namespace
  perl: update our copy of Mail::Address
  perl: update our ancient copy of Error.pm
  git-send-email: unconditionally use Net::{SMTP,Domain}
  Git.pm: hard-depend on the File::{Temp,Spec} modules
  gitweb: hard-depend on the Digest::MD5 5.8 module
  Git.pm: add the "use warnings" pragma
  Git.pm: remove redundant "use strict" from sub-package
  perl: *.pm files should not have the executable bit

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
+   scripts. However, for simplicity it doesn't use the
-   use the ExtUtils::MakeMaker toolchain to decide where to place the
+   ExtUtils::MakeMaker toolchain to decide where to place the perl
-   perl libraries. Depending on the system this can result in 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

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 $@) && \

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;

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();
-		my $domain = Net::Domain::domainname();
+	$maildomain = $domain if valid_fqdn($domain);
-		$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)) {
-		for my $host (qw(mailhost localhost)) {
+		my $smtp = Net::SMTP->new($host);
-			my $smtp = Net::SMTP->new($host);
+		if (defined $smtp) {
-			if (defined $smtp) {
+			my $domain = $smtp->domain;
-				my $domain = $smtp->domain;
+			$smtp->quit;
-				$smtp->quit;
 
-				$maildomain = $domain if valid_fqdn($domain);
+			$maildomain = $domain if valid_fqdn($domain);
 
-				last if $maildomain;
+			last if $maildomain;
-			}
 		}
 	}
 

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

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 $git_avatar =~ /^(?:gravatar|picon)$/s;
-		$git_avatar = '' unless (eval { require Digest::MD5; 1; });
-	} elsif ($git_avatar eq 'picon') {
-		# no dependencies
-	} else {
-		$git_avatar = '';
-	}
 
 	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;
 }
 

perl/FromCPAN/.gitattributes

@@ -0,0 +1 @@
+/Error.pm whitespace=-blank-at-eof

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)
+			    $err = $@ || $Error::THROWN;
-				    ? $Error::THROWN : $@;
+				$err = $Error::ObjectifyCallback->({'text' =>$err})
-                $err = $Error::ObjectifyCallback->({'text' =>$err})
+					unless ref($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)
+		$err = $@ || $Error::THROWN;
-			? $Error::THROWN : $@;
 
-        $err = $Error::ObjectifyCallback->({'text' =>$err})
+		$err = $Error::ObjectifyCallback->({'text' =>$err})
-            unless ref($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
+=head2 Error::Simple
 
-=item Error::Simple
+This class can be used to hold simple error strings and values. It's
-
-This class can be used to hold simple error strings and values. Its
 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

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;
 

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) = @_;

perl/Git/Error.pm

@@ -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;

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;

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;

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;

perl/Git/Mail/Address.pm

@@ -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;