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
This commit is contained in:
Junio C Hamano
commit
ae1644b08e
11
INSTALL
11
INSTALL
@ -88,9 +88,9 @@ Issues of note:
|
||||
export GIT_EXEC_PATH PATH GITPERLLIB
|
||||
|
||||
- By default (unless NO_PERL is provided) Git will ship various perl
|
||||
scripts & libraries it needs. However, for simplicity it doesn't
|
||||
use the ExtUtils::MakeMaker toolchain to decide where to place the
|
||||
perl libraries. Depending on the system this can result in the perl
|
||||
scripts. However, for simplicity it doesn't use the
|
||||
ExtUtils::MakeMaker toolchain to decide where to place the perl
|
||||
libraries. Depending on the system this can result in the perl
|
||||
libraries not being where you'd like them if they're expected to be
|
||||
used by things other than Git itself.
|
||||
|
||||
@ -102,6 +102,11 @@ Issues of note:
|
||||
Will result in e.g. perllibdir=/usr/share/perl/5.26.1 on Debian,
|
||||
perllibdir=/usr/share/perl5 (which we'd use by default) on CentOS.
|
||||
|
||||
- Unless NO_PERL is provided Git will ship various perl libraries it
|
||||
needs. Distributors of Git will usually want to set
|
||||
NO_PERL_CPAN_FALLBACKS if NO_PERL is not provided to use their own
|
||||
copies of the CPAN modules Git needs.
|
||||
|
||||
- Git is reasonably self-sufficient, but does depend on a few external
|
||||
programs and libraries. Git can be used without most of them by adding
|
||||
the approriate "NO_<LIBRARY>=YesPlease" to the make command line or
|
||||
|
||||
16
Makefile
16
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 $@) && \
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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;
|
||||
}
|
||||
|
||||
|
||||
1
perl/FromCPAN/.gitattributes
vendored
Normal file
1
perl/FromCPAN/.gitattributes
vendored
Normal file
@ -0,0 +1 @@
|
||||
/Error.pm whitespace=-blank-at-eof
|
||||
@ -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
|
||||
=head2 Error::Simple
|
||||
|
||||
=item 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
|
||||
@ -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;
|
||||
|
||||
14
perl/Git.pm
14
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) = @_;
|
||||
|
||||
@ -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;
|
||||
104
perl/Git/LoadCPAN.pm
Normal file
104
perl/Git/LoadCPAN.pm
Normal file
@ -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;
|
||||
10
perl/Git/LoadCPAN/Error.pm
Normal file
10
perl/Git/LoadCPAN/Error.pm
Normal file
@ -0,0 +1,10 @@
|
||||
package Git::LoadCPAN::Error;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Git::LoadCPAN (
|
||||
module => 'Error',
|
||||
import => 1,
|
||||
);
|
||||
|
||||
1;
|
||||
10
perl/Git/LoadCPAN/Mail/Address.pm
Normal file
10
perl/Git/LoadCPAN/Mail/Address.pm
Normal file
@ -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;
|
||||
@ -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;
|
||||
Loading…
Reference in New Issue
Block a user