From ca2a4f4a7ee1616b593ee7606139e10c77764006 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=C3=86var=20Arnfj=C3=B6r=C3=B0=20Bjarmason?= Date: Sun, 25 Feb 2018 19:46:25 +0000 Subject: [PATCH 01/13] perl: *.pm files should not have the executable bit MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The Git::Mail::Address file added in bd869f67b9 ("send-email: add and use a local copy of Mail::Address", 2018-01-05) had the executable bit set. That bit should not be set for *.pm files. It breaks nothing but it is redundant and confusing as none of the other files have it and these files are never executed as stand-alone programs. Signed-off-by: Ævar Arnfjörð Bjarmason Signed-off-by: Junio C Hamano --- perl/Git/Mail/Address.pm | 0 1 file changed, 0 insertions(+), 0 deletions(-) mode change 100755 => 100644 perl/Git/Mail/Address.pm diff --git a/perl/Git/Mail/Address.pm b/perl/Git/Mail/Address.pm old mode 100755 new mode 100644 From 872ba001f8caaeb496ad79c55fe587a5e31b54f2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=C3=86var=20Arnfj=C3=B6r=C3=B0=20Bjarmason?= Date: Sun, 25 Feb 2018 19:46:26 +0000 Subject: [PATCH 02/13] Git.pm: remove redundant "use strict" from sub-package MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit In Perl the "use strict/warnings" pragmas are lexical, thus there's no reason to do: package Foo; use strict; package Bar; use strict; $x = 5; To satisfy the desire that the undeclared $x variable will be spotted at compile-time. It's enough to include the first "use strict". This functionally changes nothing, but makes a subsequent change where "use warnings" will be added to Git.pm less confusing and less verbose, since as with "strict" we'll only need to do that at the top of the file. Changes code initially added in a6065b548f ("Git.pm: Try to support ActiveState output pipe", 2006-06-25). Signed-off-by: Ævar Arnfjörð Bjarmason Signed-off-by: Junio C Hamano --- perl/Git.pm | 1 - 1 file changed, 1 deletion(-) diff --git a/perl/Git.pm b/perl/Git.pm index 9d60d7948b..99e5d943af 100644 --- a/perl/Git.pm +++ b/perl/Git.pm @@ -1692,7 +1692,6 @@ sub DESTROY { # Pipe implementation for ActiveState Perl. package Git::activestate_pipe; -use strict; sub TIEHANDLE { my ($class, @params) = @_; From f0e19cb7ced7b640d363b61d7ce17b83901777da Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=C3=86var=20Arnfj=C3=B6r=C3=B0=20Bjarmason?= Date: Sun, 25 Feb 2018 19:46:27 +0000 Subject: [PATCH 03/13] Git.pm: add the "use warnings" pragma MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Amend Git.pm to load the "warnings" pragma like the rest of the code in perl/ in addition to the existing "strict" pragma. This is considered the bare minimum best practice in Perl. Ever since this code was introduced in b1edc53d06 ("Introduce Git.pm (v4)", 2006-06-24) it's only been using "strict", not "warnings". This leaves contrib/buildsystems/Generators/{QMake,VCproj}.pm and contrib/mw-to-git/Git/Mediawiki.pm without "use warnings". Amending those would be a sensible follow-up change, but I don't have an easy way to test those so I'm not changing them. Signed-off-by: Ævar Arnfjörð Bjarmason Signed-off-by: Junio C Hamano --- perl/Git.pm | 1 + 1 file changed, 1 insertion(+) diff --git a/perl/Git.pm b/perl/Git.pm index 99e5d943af..7ec16e6dde 100644 --- a/perl/Git.pm +++ b/perl/Git.pm @@ -9,6 +9,7 @@ package Git; use 5.008; use strict; +use warnings; BEGIN { From 7d5b30e09fc705b84bba57ac655263ab6d8f71a6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=C3=86var=20Arnfj=C3=B6r=C3=B0=20Bjarmason?= Date: Sat, 3 Mar 2018 15:38:08 +0000 Subject: [PATCH 04/13] gitweb: hard-depend on the Digest::MD5 5.8 module MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Since my d48b284183 ("perl: bump the required Perl version to 5.8 from 5.6.[21]", 2010-09-24), we've depended on 5.8, so there's no reason to conditionally require Digest::MD5 anymore. It was released with perl v5.7.3[1] The initial introduction of the dependency in e9fdd74e53 ("gitweb: (gr)avatar support", 2009-06-30) says as much, this also undoes part of the later 2e9c8789b7 ("gitweb: Mention optional Perl modules in INSTALL", 2011-02-04) since gitweb will always be run on at least 5.8, so there's no need to mention Digest::MD5 as a required module in the documentation, let's instead say that we require perl 5.8. 1. $ corelist Digest::MD5 Data for 2015-02-14 Digest::MD5 was first released with perl v5.7.3 Signed-off-by: Ævar Arnfjörð Bjarmason Signed-off-by: Junio C Hamano --- gitweb/INSTALL | 3 +-- gitweb/gitweb.perl | 17 ++++------------- 2 files changed, 5 insertions(+), 15 deletions(-) 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; } From 29118b37eb8510dc42dd94e127f7c92d05963d1d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=C3=86var=20Arnfj=C3=B6r=C3=B0=20Bjarmason?= Date: Sat, 3 Mar 2018 15:38:09 +0000 Subject: [PATCH 05/13] Git.pm: hard-depend on the File::{Temp,Spec} modules MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Since my d48b284183 ("perl: bump the required Perl version to 5.8 from 5.6.[21]", 2010-09-24), we've depended on 5.8, so there's no reason to conditionally require File::Temp and File::Spec anymore. They were first released with perl versions v5.6.1 and 5.00405, respectively. This code was originally added in c14c8ceb13 ("Git.pm: Make File::Spec and File::Temp requirement lazy", 2008-08-15), presumably to make Git.pm work on 5.6.0. Signed-off-by: Ævar Arnfjörð Bjarmason Signed-off-by: Junio C Hamano --- perl/Git.pm | 10 ++-------- 1 file changed, 2 insertions(+), 8 deletions(-) diff --git a/perl/Git.pm b/perl/Git.pm index 7ec16e6dde..151b0e7144 100644 --- a/perl/Git.pm +++ b/perl/Git.pm @@ -11,6 +11,8 @@ use 5.008; use strict; use warnings; +use File::Temp (); +use File::Spec (); BEGIN { @@ -190,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); @@ -1289,8 +1290,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}) { @@ -1324,11 +1323,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. From 1046c118d8116496dc4737b9229bdf7339202ba6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=C3=86var=20Arnfj=C3=B6r=C3=B0=20Bjarmason?= Date: Sat, 3 Mar 2018 15:38:10 +0000 Subject: [PATCH 06/13] git-send-email: unconditionally use Net::{SMTP,Domain} MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The Net::SMTP and Net::Domain were both first released with perl v5.7.3[1], since my d48b284183 ("perl: bump the required Perl version to 5.8 from 5.6.[21]", 2010-09-24) we've depended on 5.8, so there's no reason to conditionally require them anymore. This conditional loading was initially added in 87840620fd ("send-email: only 'require' instead of 'use' Net::SMTP", 2006-06-01) for Net::SMTP and 134550fe21 ("git-send-email.perl - try to give real name of the calling host to HELO/EHLO", 2010-03-14) for Net::Domain, both of which predate the hard dependency on 5.8. Since they're guaranteed to be installed now let's "use" them instead. The cost of loading them both is trivial given what git-send-email does (~15ms on my system), and it's better to not defer any potential loading errors until runtime. This patch is better viewed with -w, which shows that the only change in the last two hunks is removing the "if eval" wrapper block. 1. $ parallel 'corelist {}' ::: Net::{SMTP,Domain} Data for 2015-02-14 Net::SMTP was first released with perl v5.7.3 Data for 2015-02-14 Net::Domain was first released with perl v5.7.3 Signed-off-by: Ævar Arnfjörð Bjarmason Signed-off-by: Junio C Hamano --- git-send-email.perl | 24 +++++++++++------------- 1 file changed, 11 insertions(+), 13 deletions(-) diff --git a/git-send-email.perl b/git-send-email.perl index bbf4deaa0d..d5a4826a1c 100755 --- a/git-send-email.perl +++ b/git-send-email.perl @@ -31,6 +31,8 @@ use Cwd qw(abs_path cwd); use Git; use Git::I18N; use Git::Mail::Address; +use Net::Domain (); +use Net::SMTP (); Getopt::Long::Configure qw/ pass_through /; @@ -1143,10 +1145,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; } @@ -1154,17 +1154,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; } } From e5741c3627a9b50ba1f87a33d1ee2c3410486cac Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=C3=86var=20Arnfj=C3=B6r=C3=B0=20Bjarmason?= Date: Sat, 3 Mar 2018 15:38:11 +0000 Subject: [PATCH 07/13] perl: update our ancient copy of Error.pm MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The Error.pm shipped with Git as a fallback if there was no Error.pm on the system was released in April 2006. There's been dozens of releases since then, the latest at August 7, 2017. Let's update to that. I don't know of anything we need from this new release or which this fixes. This change is simply a matter of keeping up with upstream. Before this users who'd install git via their package system would get an up-to-date Error.pm, but if it's installed from source they'd get one more than a decade old. This undoes a local hack we'd accumulated in 96bc4de85c ("Eliminate Scalar::Util usage from private-Error.pm", 2006-07-26), it's been redundant since my d48b284183 ("perl: bump the required Perl version to 5.8 from 5.6.[21]", 2010-09-24). This also undoes 3a51467b94 ("Typo fix: replacing it's -> its", 2013-04-13). This is the Nth time I find that some upstream code of ours (in contrib/, in sha1dc/ and now in perl/ ...) has diverged from upstream because of some tree-wide typo fixing. Let's not do those fixes against upstream projects, it's more valuable that we have a 1=1 mapping to upstream than to fix typos in docs we never even generate from this code. If someone wants to fix typos in them fine, but they should do it with a patch to upstream which git.git can then incorporate. The upstream code doesn't cleanly pass a --check, so I'm adding a .gitattributes file for similar reasons as done for sha1dc in 5d184f468e ("sha1dc: ignore indent-with-non-tab whitespace violations", 2017-06-06). The updated source was retrieved from https://fastapi.metacpan.org/source/SHLOMIF/Error-0.17025/lib/Error.pm Signed-off-by: Ævar Arnfjörð Bjarmason Signed-off-by: Junio C Hamano --- perl/Git/FromCPAN/.gitattributes | 1 + perl/Git/FromCPAN/Error.pm | 295 ++++++++++++++++++++++++++----- 2 files changed, 255 insertions(+), 41 deletions(-) create mode 100644 perl/Git/FromCPAN/.gitattributes diff --git a/perl/Git/FromCPAN/.gitattributes b/perl/Git/FromCPAN/.gitattributes new file mode 100644 index 0000000000..8b64fc5e22 --- /dev/null +++ b/perl/Git/FromCPAN/.gitattributes @@ -0,0 +1 @@ +/Error.pm whitespace=-blank-at-eof diff --git a/perl/Git/FromCPAN/Error.pm b/perl/Git/FromCPAN/Error.pm index 6098135ae2..8b95e2d73d 100644 --- a/perl/Git/FromCPAN/Error.pm +++ b/perl/Git/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 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 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-Ethrow> @@ -608,7 +722,7 @@ type. Catch any error by executing the code in C When evaluated C 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 exports a keyword called C 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 for the report.). + =head1 CLASS INTERFACE =head2 CONSTRUCTORS The C 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 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 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 also provides handlers to extend the output of the C perl +function, and to handle the printing of a thrown C that is not caught +or otherwise handled. These are not installed by default, but are requested +using the C<:warndie> tag in the C 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 provides. If this cannot be +avoided, then the tag can be explicitly Ced 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 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, +C, 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 aims to combine L and L +"with correct stringification". + +L and L 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 and adapted by Jesse Glick . +C<:warndie> handlers added by Paul Evans + =head1 MAINTAINER -Shlomi Fish +Shlomi Fish, L . =head1 PAST MAINTAINERS Arun Kumar U +=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 From 10cf3b076da31320108ad16bc3695a5e6a4600b0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=C3=86var=20Arnfj=C3=B6r=C3=B0=20Bjarmason?= Date: Sat, 3 Mar 2018 15:38:12 +0000 Subject: [PATCH 08/13] perl: update our copy of Mail::Address MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Update our copy of Mail::Address from 2.19 (Aug 22, 2017) to 2.20 (Jan 23, 2018). Like the preceding Error.pm update this is done simply to keep up-to-date with upstream, and as can be shown from the diff there's no functional changes. The updated source was retrieved from https://fastapi.metacpan.org/source/MARKOV/MailTools-2.20/lib/Mail/Address.pm Signed-off-by: Ævar Arnfjörð Bjarmason Signed-off-by: Junio C Hamano --- perl/Git/FromCPAN/Mail/Address.pm | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/perl/Git/FromCPAN/Mail/Address.pm b/perl/Git/FromCPAN/Mail/Address.pm index 13b2ff7d05..683d490b2b 100644 --- a/perl/Git/FromCPAN/Mail/Address.pm +++ b/perl/Git/FromCPAN/Mail/Address.pm @@ -1,10 +1,14 @@ -# Copyrights 1995-2017 by [Mark Overmeer ]. +# 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; From 28654678cff4c7b78f87a6768a896d76a1784d45 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=C3=86var=20Arnfj=C3=B6r=C3=B0=20Bjarmason?= Date: Sat, 3 Mar 2018 15:38:13 +0000 Subject: [PATCH 09/13] perl: move CPAN loader wrappers to another namespace MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Move the Git::Error and Git::Mail::Address wrappers to the Git::LoadCPAN::Loader::* namespace, e.g. Git::LoadCPAN::Error. That module will then either load Error from CPAN (if installed on the OS), or use Git::FromCPAN::Error. When I added the Error wrapper in 20d2a30f8f ("Makefile: replace perl/Makefile.PL with simple make rules", 2017-12-10) I didn't think about how confusing it would be to have these modules sitting in the same tree as our normal modules. Let's put these all into Git::{Load,From}CPAN::* to clearly distinguish them from the rest. This also makes things a bit less confusing since there was already a Git::Error namespace ever since 8b9150e3e3 ("Git.pm: Handle failed commands' output", 2006-06-24). Signed-off-by: Ævar Arnfjörð Bjarmason Signed-off-by: Junio C Hamano --- contrib/examples/git-difftool.perl | 2 +- git-send-email.perl | 4 ++-- perl/Git.pm | 2 +- perl/Git/{ => LoadCPAN}/Error.pm | 8 ++++---- perl/Git/{ => LoadCPAN}/Mail/Address.pm | 4 ++-- 5 files changed, 10 insertions(+), 10 deletions(-) rename perl/Git/{ => LoadCPAN}/Error.pm (78%) rename perl/Git/{ => LoadCPAN}/Mail/Address.pm (69%) 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 d5a4826a1c..1ec22c5ef3 100755 --- a/git-send-email.perl +++ b/git-send-email.perl @@ -26,13 +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 /; diff --git a/perl/Git.pm b/perl/Git.pm index 151b0e7144..9f246c7988 100644 --- a/perl/Git.pm +++ b/perl/Git.pm @@ -104,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); diff --git a/perl/Git/Error.pm b/perl/Git/LoadCPAN/Error.pm similarity index 78% rename from perl/Git/Error.pm rename to perl/Git/LoadCPAN/Error.pm index 09bbc97390..3513fe745b 100644 --- a/perl/Git/Error.pm +++ b/perl/Git/LoadCPAN/Error.pm @@ -1,11 +1,11 @@ -package Git::Error; +package Git::LoadCPAN::Error; use 5.008; use strict; use warnings; =head1 NAME -Git::Error - Wrapper for the L module, in case it's not installed +Git::LoadCPAN::Error - Wrapper for the L module, in case it's not installed =head1 DESCRIPTION @@ -26,13 +26,13 @@ sub import { } or do { my $error = $@ || "Zombie Error"; - my $Git_Error_pm_path = $INC{"Git/Error.pm"} || die "BUG: Should have our own path from %INC!"; + my $Git_Error_pm_path = $INC{"Git/LoadCPAN/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'); + 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); diff --git a/perl/Git/Mail/Address.pm b/perl/Git/LoadCPAN/Mail/Address.pm similarity index 69% rename from perl/Git/Mail/Address.pm rename to perl/Git/LoadCPAN/Mail/Address.pm index 2ce3e84670..879c2f5cd1 100644 --- a/perl/Git/Mail/Address.pm +++ b/perl/Git/LoadCPAN/Mail/Address.pm @@ -1,11 +1,11 @@ -package Git::Mail::Address; +package Git::LoadCPAN::Mail::Address; use 5.008; use strict; use warnings; =head1 NAME -Git::Mail::Address - Wrapper for the L module, in case it's not installed +Git::LoadCPAN::Mail::Address - Wrapper for the L module, in case it's not installed =head1 DESCRIPTION From edfb7b92a1dbd70858ea5c5356cdb6dc14ec8d3a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=C3=86var=20Arnfj=C3=B6r=C3=B0=20Bjarmason?= Date: Sat, 3 Mar 2018 15:38:14 +0000 Subject: [PATCH 10/13] perl: generalize the Git::LoadCPAN facility MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Change the two wrappers that load from CPAN (local OS) or our own copy to do so via the same codepath. I added the Error.pm wrapper in 20d2a30f8f ("Makefile: replace perl/Makefile.PL with simple make rules", 2017-12-10), and shortly afterwards Matthieu Moy added a wrapper for Mail::Address in bd869f67b9 ("send-email: add and use a local copy of Mail::Address", 2018-01-05). His loader was simpler since Mail::Address doesn't have an "import" method, but didn't do the same sanity checking; For example, a missing FromCPAN directory (which OS packages are likely not to have) wouldn't be explicitly warned about as a "BUG: ...". Update both to use a common implementation based on the previous Error.pm loader. Which has been amended to take the module to load as parameter, as well as whether or not that module has an import method. This loader should be generic enough to handle almost all CPAN modules out there, some use some crazy loading magic and wouldn't like being wrapped like this, but that would be immediately obvious, and we'd find out right away since the module wouldn't work at all. Signed-off-by: Ævar Arnfjörð Bjarmason Signed-off-by: Junio C Hamano --- perl/Git/LoadCPAN.pm | 74 +++++++++++++++++++++++++++++++ perl/Git/LoadCPAN/Error.pm | 44 ++---------------- perl/Git/LoadCPAN/Mail/Address.pm | 22 ++------- 3 files changed, 82 insertions(+), 58 deletions(-) create mode 100644 perl/Git/LoadCPAN.pm diff --git a/perl/Git/LoadCPAN.pm b/perl/Git/LoadCPAN.pm new file mode 100644 index 0000000000..1568c177fe --- /dev/null +++ b/perl/Git/LoadCPAN.pm @@ -0,0 +1,74 @@ +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 namespace shipped with Git contains +wrapper modules like C that will first +attempt to load C from the OS, and if that doesn't work +will fall back on C shipped with Git +itself. + +Usually distributors will not ship with Git's Git::FromCPAN tree at +all, preferring to use their own packaging of CPAN modules instead. + +This module is only intended to be used for code shipping in the +C repository. Use it for anything else at your peril! + +=cut + +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"; + + 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 index 3513fe745b..c6d2c45d80 100644 --- a/perl/Git/LoadCPAN/Error.pm +++ b/perl/Git/LoadCPAN/Error.pm @@ -2,45 +2,9 @@ package Git::LoadCPAN::Error; use 5.008; use strict; use warnings; - -=head1 NAME - -Git::LoadCPAN::Error - Wrapper for the L module, in case it's not installed - -=head1 DESCRIPTION - -Wraps the import function for the L module. - -This module is only intended to be used for code shipping in the -C 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/LoadCPAN/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; -} +use Git::LoadCPAN ( + module => 'Error', + import => 1, +); 1; diff --git a/perl/Git/LoadCPAN/Mail/Address.pm b/perl/Git/LoadCPAN/Mail/Address.pm index 879c2f5cd1..f70a4f064c 100644 --- a/perl/Git/LoadCPAN/Mail/Address.pm +++ b/perl/Git/LoadCPAN/Mail/Address.pm @@ -2,23 +2,9 @@ package Git::LoadCPAN::Mail::Address; use 5.008; use strict; use warnings; - -=head1 NAME - -Git::LoadCPAN::Mail::Address - Wrapper for the L module, in case it's not installed - -=head1 DESCRIPTION - -This module is only intended to be used for code shipping in the -C repository. Use it for anything else at your peril! - -=cut - -eval { - require Mail::Address; - 1; -} or do { - require Git::FromCPAN::Mail::Address; -}; +use Git::LoadCPAN ( + module => 'Mail::Address', + import => 0, +); 1; From 382029fc003d400147339573ab5448a88c336f55 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=C3=86var=20Arnfj=C3=B6r=C3=B0=20Bjarmason?= Date: Sat, 3 Mar 2018 15:38:15 +0000 Subject: [PATCH 11/13] perl: move the perl/Git/FromCPAN tree to perl/FromCPAN MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Move the CPAN modules that have lived under perl/Git/FromCPAN since my 20d2a30f8f ("Makefile: replace perl/Makefile.PL with simple make rules", 2017-12-10) to perl/FromCPAN. A subsequent change will teach the Makefile to only install these copies of CPAN modules if a flag that distro packagers would like to set isn't set. Due to how the wildcard globbing is being done it's much easier to accomplish that if they're moved to their own directory. Signed-off-by: Ævar Arnfjörð Bjarmason Signed-off-by: Junio C Hamano --- Makefile | 3 +++ perl/{Git => }/FromCPAN/.gitattributes | 0 perl/{Git => }/FromCPAN/Error.pm | 0 perl/{Git => }/FromCPAN/Mail/Address.pm | 0 perl/Git/LoadCPAN.pm | 5 ++--- 5 files changed, 5 insertions(+), 3 deletions(-) rename perl/{Git => }/FromCPAN/.gitattributes (100%) rename perl/{Git => }/FromCPAN/Error.pm (100%) rename perl/{Git => }/FromCPAN/Mail/Address.pm (100%) diff --git a/Makefile b/Makefile index c56fdc14ca..7b97699864 100644 --- a/Makefile +++ b/Makefile @@ -2300,9 +2300,12 @@ 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) +all:: $(LIB_CPAN_GEN) endif perl/build/lib/%.pm: perl/%.pm diff --git a/perl/Git/FromCPAN/.gitattributes b/perl/FromCPAN/.gitattributes similarity index 100% rename from perl/Git/FromCPAN/.gitattributes rename to perl/FromCPAN/.gitattributes diff --git a/perl/Git/FromCPAN/Error.pm b/perl/FromCPAN/Error.pm similarity index 100% rename from perl/Git/FromCPAN/Error.pm rename to perl/FromCPAN/Error.pm diff --git a/perl/Git/FromCPAN/Mail/Address.pm b/perl/FromCPAN/Mail/Address.pm similarity index 100% rename from perl/Git/FromCPAN/Mail/Address.pm rename to perl/FromCPAN/Mail/Address.pm diff --git a/perl/Git/LoadCPAN.pm b/perl/Git/LoadCPAN.pm index 1568c177fe..229c1ee87d 100644 --- a/perl/Git/LoadCPAN.pm +++ b/perl/Git/LoadCPAN.pm @@ -16,8 +16,7 @@ source. Therefore the L namespace shipped with Git contains wrapper modules like C that will first attempt to load C from the OS, and if that doesn't work -will fall back on C shipped with Git -itself. +will fall back on C shipped with Git itself. Usually distributors will not ship with Git's Git::FromCPAN tree at all, preferring to use their own packaging of CPAN modules instead. @@ -52,7 +51,7 @@ sub import { 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'); + 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); From 075321c0075b1ef86b98facc88bcaeefeb9584d1 Mon Sep 17 00:00:00 2001 From: Todd Zullinger Date: Sat, 3 Mar 2018 15:38:16 +0000 Subject: [PATCH 12/13] Makefile: add NO_PERL_CPAN_FALLBACKS knob MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit We include some perl modules which are not part of the core perl install, as a convenience. This allows us to rely on those modules in our perl-based tools and scripts without requiring users to install the modules from CPAN or their operating system packages. Users whose operating system provides these modules and packagers of Git often don't want to ship or use these bundled modules. Allow these users to set NO_PERL_CPAN_FALLBACKS to avoid installing the bundled modules. Signed-off-by: Todd Zullinger Signed-off-by: Ævar Arnfjörð Bjarmason Signed-off-by: Junio C Hamano --- Makefile | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/Makefile b/Makefile index 7b97699864..518c5f6be0 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). # @@ -2305,8 +2311,10 @@ 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 +endif perl/build/lib/%.pm: perl/%.pm $(QUIET_GEN)mkdir -p $(dir $@) && \ From 1aca69c0195bd4ac671e7a36cf9b967d2bcbe200 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=C3=86var=20Arnfj=C3=B6r=C3=B0=20Bjarmason?= Date: Sat, 3 Mar 2018 15:38:17 +0000 Subject: [PATCH 13/13] perl Git::LoadCPAN: emit better errors under NO_PERL_CPAN_FALLBACKS MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Before my 20d2a30f8f ("Makefile: replace perl/Makefile.PL with simple make rules", 2017-12-10) on an OS package that removed the private-Error.pm copy we carried around manually removing the OS's Error.pm would yield: $ git add -p Can't locate Error.pm in @INC (you may need to install the Error module) [...] Now, before this change we'll instead emit this more cryptic error: $ git add -p BUG: '/usr/share/perl5/Git/FromCPAN' should be a directory! at /usr/share/perl5/Git/Error.pm line 36. This is a confusing error. Now if the new NO_PERL_CPAN_FALLBACKS option is specified and we can't find the module we'll instead emit: $ /tmp/git/bin/git add -p BUG: The 'Error' module is not here, but NO_PERL_CPAN_FALLBACKS was set! [...] Where [...] is the lengthy explanation seen in the change below, which explains what the potential breakage is, and how to fix it. The reason for checking @@NO_PERL_CPAN_FALLBACKS@@] against the empty string in Perl is as opposed to checking for a boolean value is that that's (as far as I can tell) make's idea of a string that's set, and e.g. NO_PERL_CPAN_FALLBACKS=0 is enough to set NO_PERL_CPAN_FALLBACKS. Signed-off-by: Ævar Arnfjörð Bjarmason Signed-off-by: Junio C Hamano --- INSTALL | 11 ++++++++--- Makefile | 5 ++++- perl/Git/LoadCPAN.pm | 33 ++++++++++++++++++++++++++++++++- 3 files changed, 44 insertions(+), 5 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_=YesPlease" to the make command line or diff --git a/Makefile b/Makefile index 518c5f6be0..4e0cdb3ca4 100644 --- a/Makefile +++ b/Makefile @@ -2314,11 +2314,14 @@ 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/perl/Git/LoadCPAN.pm b/perl/Git/LoadCPAN.pm index 229c1ee87d..e5585e75e8 100644 --- a/perl/Git/LoadCPAN.pm +++ b/perl/Git/LoadCPAN.pm @@ -19,13 +19,25 @@ attempt to load C from the OS, and if that doesn't work will fall back on C shipped with Git itself. Usually distributors will not ship with Git's Git::FromCPAN tree at -all, preferring to use their own packaging of CPAN modules instead. +all via the C 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 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; @@ -45,6 +57,25 @@ sub import { } 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;