diff options
author | Junio C Hamano <gitster@pobox.com> | 2018-03-15 15:00:46 -0700 |
---|---|---|
committer | Junio C Hamano <gitster@pobox.com> | 2018-03-15 15:00:46 -0700 |
commit | ae1644b08e85fb64367b273337d8ebcbdabe0685 (patch) | |
tree | a4abf768e05299a5152bcbb93b298462b44ad2e7 | |
parent | Merge branch 'cl/send-email-reply-to' (diff) | |
parent | perl Git::LoadCPAN: emit better errors under NO_PERL_CPAN_FALLBACKS (diff) | |
download | tgif-ae1644b08e85fb64367b273337d8ebcbdabe0685.tar.xz |
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
-rw-r--r-- | INSTALL | 11 | ||||
-rw-r--r-- | Makefile | 16 | ||||
-rwxr-xr-x | contrib/examples/git-difftool.perl | 2 | ||||
-rwxr-xr-x | git-send-email.perl | 28 | ||||
-rw-r--r-- | gitweb/INSTALL | 3 | ||||
-rwxr-xr-x | gitweb/gitweb.perl | 17 | ||||
-rw-r--r-- | perl/FromCPAN/.gitattributes | 1 | ||||
-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.pm | 14 | ||||
-rw-r--r-- | perl/Git/Error.pm | 46 | ||||
-rw-r--r-- | perl/Git/LoadCPAN.pm | 104 | ||||
-rw-r--r-- | perl/Git/LoadCPAN/Error.pm | 10 | ||||
-rw-r--r-- | perl/Git/LoadCPAN/Mail/Address.pm | 10 | ||||
-rwxr-xr-x | perl/Git/Mail/Address.pm | 24 |
15 files changed, 431 insertions, 158 deletions
@@ -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 @@ -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; |