perl: move the perl/Git/FromCPAN tree to perl/FromCPAN
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 <avarab@gmail.com>
Signed-off-by: Junio C Hamano <gitster@pobox.com>
This commit is contained in:
Ævar Arnfjörð Bjarmason
committed by
Junio C Hamano
Junio C Hamano
parent
edfb7b92a1
commit
382029fc00
1
perl/Git/FromCPAN/.gitattributes
vendored
1
perl/Git/FromCPAN/.gitattributes
vendored
@ -1 +0,0 @@
|
||||
/Error.pm whitespace=-blank-at-eof
|
||||
File diff suppressed because it is too large
Load Diff
@ -1,280 +0,0 @@
|
||||
# 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.20';
|
||||
|
||||
use strict;
|
||||
|
||||
use Carp;
|
||||
|
||||
# use locale; removed in version 1.78, because it causes taint problems
|
||||
|
||||
sub Version { our $VERSION }
|
||||
|
||||
|
||||
|
||||
# given a comment, attempt to extract a person's name
|
||||
sub _extract_name
|
||||
{ # This function can be called as method as well
|
||||
my $self = @_ && ref $_[0] ? shift : undef;
|
||||
|
||||
local $_ = shift
|
||||
or return '';
|
||||
|
||||
# Using encodings, too hard. See Mail::Message::Field::Full.
|
||||
return '' if m/\=\?.*?\?\=/;
|
||||
|
||||
# trim whitespace
|
||||
s/^\s+//;
|
||||
s/\s+$//;
|
||||
s/\s+/ /;
|
||||
|
||||
# Disregard numeric names (e.g. 123456.1234@compuserve.com)
|
||||
return "" if /^[\d ]+$/;
|
||||
|
||||
s/^\((.*)\)$/$1/; # remove outermost parenthesis
|
||||
s/^"(.*)"$/$1/; # remove outer quotation marks
|
||||
s/\(.*?\)//g; # remove minimal embedded comments
|
||||
s/\\//g; # remove all escapes
|
||||
s/^"(.*)"$/$1/; # remove internal quotation marks
|
||||
s/^([^\s]+) ?, ?(.*)$/$2 $1/; # reverse "Last, First M." if applicable
|
||||
s/,.*//;
|
||||
|
||||
# Change casing only when the name contains only upper or only
|
||||
# lower cased characters.
|
||||
unless( m/[A-Z]/ && m/[a-z]/ )
|
||||
{ # Set the case of the name to first char upper rest lower
|
||||
s/\b(\w+)/\L\u$1/igo; # Upcase first letter on name
|
||||
s/\bMc(\w)/Mc\u$1/igo; # Scottish names such as 'McLeod'
|
||||
s/\bo'(\w)/O'\u$1/igo; # Irish names such as 'O'Malley, O'Reilly'
|
||||
s/\b(x*(ix)?v*(iv)?i*)\b/\U$1/igo; # Roman numerals, eg 'Level III Support'
|
||||
}
|
||||
|
||||
# some cleanup
|
||||
s/\[[^\]]*\]//g;
|
||||
s/(^[\s'"]+|[\s'"]+$)//g;
|
||||
s/\s{2,}/ /g;
|
||||
|
||||
$_;
|
||||
}
|
||||
|
||||
sub _tokenise
|
||||
{ local $_ = join ',', @_;
|
||||
my (@words,$snippet,$field);
|
||||
|
||||
s/\A\s+//;
|
||||
s/[\r\n]+/ /g;
|
||||
|
||||
while ($_ ne '')
|
||||
{ $field = '';
|
||||
if(s/^\s*\(/(/ ) # (...)
|
||||
{ my $depth = 0;
|
||||
|
||||
PAREN: while(s/^(\(([^\(\)\\]|\\.)*)//)
|
||||
{ $field .= $1;
|
||||
$depth++;
|
||||
while(s/^(([^\(\)\\]|\\.)*\)\s*)//)
|
||||
{ $field .= $1;
|
||||
last PAREN unless --$depth;
|
||||
$field .= $1 if s/^(([^\(\)\\]|\\.)+)//;
|
||||
}
|
||||
}
|
||||
|
||||
carp "Unmatched () '$field' '$_'"
|
||||
if $depth;
|
||||
|
||||
$field =~ s/\s+\Z//;
|
||||
push @words, $field;
|
||||
|
||||
next;
|
||||
}
|
||||
|
||||
if( s/^("(?:[^"\\]+|\\.)*")\s*// # "..."
|
||||
|| s/^(\[(?:[^\]\\]+|\\.)*\])\s*// # [...]
|
||||
|| s/^([^\s()<>\@,;:\\".[\]]+)\s*//
|
||||
|| s/^([()<>\@,;:\\".[\]])\s*//
|
||||
)
|
||||
{ push @words, $1;
|
||||
next;
|
||||
}
|
||||
|
||||
croak "Unrecognised line: $_";
|
||||
}
|
||||
|
||||
push @words, ",";
|
||||
\@words;
|
||||
}
|
||||
|
||||
sub _find_next
|
||||
{ my ($idx, $tokens, $len) = @_;
|
||||
|
||||
while($idx < $len)
|
||||
{ my $c = $tokens->[$idx];
|
||||
return $c if $c eq ',' || $c eq ';' || $c eq '<';
|
||||
$idx++;
|
||||
}
|
||||
|
||||
"";
|
||||
}
|
||||
|
||||
sub _complete
|
||||
{ my ($class, $phrase, $address, $comment) = @_;
|
||||
|
||||
@$phrase || @$comment || @$address
|
||||
or return undef;
|
||||
|
||||
my $o = $class->new(join(" ",@$phrase), join("",@$address), join(" ",@$comment));
|
||||
@$phrase = @$address = @$comment = ();
|
||||
$o;
|
||||
}
|
||||
|
||||
#------------
|
||||
|
||||
sub new(@)
|
||||
{ my $class = shift;
|
||||
bless [@_], $class;
|
||||
}
|
||||
|
||||
|
||||
sub parse(@)
|
||||
{ my $class = shift;
|
||||
my @line = grep {defined} @_;
|
||||
my $line = join '', @line;
|
||||
|
||||
my (@phrase, @comment, @address, @objs);
|
||||
my ($depth, $idx) = (0, 0);
|
||||
|
||||
my $tokens = _tokenise @line;
|
||||
my $len = @$tokens;
|
||||
my $next = _find_next $idx, $tokens, $len;
|
||||
|
||||
local $_;
|
||||
for(my $idx = 0; $idx < $len; $idx++)
|
||||
{ $_ = $tokens->[$idx];
|
||||
|
||||
if(substr($_,0,1) eq '(') { push @comment, $_ }
|
||||
elsif($_ eq '<') { $depth++ }
|
||||
elsif($_ eq '>') { $depth-- if $depth }
|
||||
elsif($_ eq ',' || $_ eq ';')
|
||||
{ warn "Unmatched '<>' in $line" if $depth;
|
||||
my $o = $class->_complete(\@phrase, \@address, \@comment);
|
||||
push @objs, $o if defined $o;
|
||||
$depth = 0;
|
||||
$next = _find_next $idx+1, $tokens, $len;
|
||||
}
|
||||
elsif($depth) { push @address, $_ }
|
||||
elsif($next eq '<') { push @phrase, $_ }
|
||||
elsif( /^[.\@:;]$/ || !@address || $address[-1] =~ /^[.\@:;]$/ )
|
||||
{ push @address, $_ }
|
||||
else
|
||||
{ warn "Unmatched '<>' in $line" if $depth;
|
||||
my $o = $class->_complete(\@phrase, \@address, \@comment);
|
||||
push @objs, $o if defined $o;
|
||||
$depth = 0;
|
||||
push @address, $_;
|
||||
}
|
||||
}
|
||||
@objs;
|
||||
}
|
||||
|
||||
#------------
|
||||
|
||||
sub phrase { shift->set_or_get(0, @_) }
|
||||
sub address { shift->set_or_get(1, @_) }
|
||||
sub comment { shift->set_or_get(2, @_) }
|
||||
|
||||
sub set_or_get($)
|
||||
{ my ($self, $i) = (shift, shift);
|
||||
@_ or return $self->[$i];
|
||||
|
||||
my $val = $self->[$i];
|
||||
$self->[$i] = shift if @_;
|
||||
$val;
|
||||
}
|
||||
|
||||
|
||||
my $atext = '[\-\w !#$%&\'*+/=?^`{|}~]';
|
||||
sub format
|
||||
{ my @addrs;
|
||||
|
||||
foreach (@_)
|
||||
{ my ($phrase, $email, $comment) = @$_;
|
||||
my @addr;
|
||||
|
||||
if(defined $phrase && length $phrase)
|
||||
{ push @addr
|
||||
, $phrase =~ /^(?:\s*$atext\s*)+$/o ? $phrase
|
||||
: $phrase =~ /(?<!\\)"/ ? $phrase
|
||||
: qq("$phrase");
|
||||
|
||||
push @addr, "<$email>"
|
||||
if defined $email && length $email;
|
||||
}
|
||||
elsif(defined $email && length $email)
|
||||
{ push @addr, $email;
|
||||
}
|
||||
|
||||
if(defined $comment && $comment =~ /\S/)
|
||||
{ $comment =~ s/^\s*\(?/(/;
|
||||
$comment =~ s/\)?\s*$/)/;
|
||||
}
|
||||
|
||||
push @addr, $comment
|
||||
if defined $comment && length $comment;
|
||||
|
||||
push @addrs, join(" ", @addr)
|
||||
if @addr;
|
||||
}
|
||||
|
||||
join ", ", @addrs;
|
||||
}
|
||||
|
||||
#------------
|
||||
|
||||
sub name
|
||||
{ my $self = shift;
|
||||
my $phrase = $self->phrase;
|
||||
my $addr = $self->address;
|
||||
|
||||
$phrase = $self->comment
|
||||
unless defined $phrase && length $phrase;
|
||||
|
||||
my $name = $self->_extract_name($phrase);
|
||||
|
||||
# first.last@domain address
|
||||
if($name eq '' && $addr =~ /([^\%\.\@_]+([\._][^\%\.\@_]+)+)[\@\%]/)
|
||||
{ ($name = $1) =~ s/[\._]+/ /g;
|
||||
$name = _extract_name $name;
|
||||
}
|
||||
|
||||
if($name eq '' && $addr =~ m#/g=#i) # X400 style address
|
||||
{ my ($f) = $addr =~ m#g=([^/]*)#i;
|
||||
my ($l) = $addr =~ m#s=([^/]*)#i;
|
||||
$name = _extract_name "$f $l";
|
||||
}
|
||||
|
||||
length $name ? $name : undef;
|
||||
}
|
||||
|
||||
|
||||
sub host
|
||||
{ my $addr = shift->address || '';
|
||||
my $i = rindex $addr, '@';
|
||||
$i >= 0 ? substr($addr, $i+1) : undef;
|
||||
}
|
||||
|
||||
|
||||
sub user
|
||||
{ my $addr = shift->address || '';
|
||||
my $i = rindex $addr, '@';
|
||||
$i >= 0 ? substr($addr,0,$i) : $addr;
|
||||
}
|
||||
|
||||
1;
|
||||
@ -16,8 +16,7 @@ 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<Git::FromCPAN::Module::Name> shipped with Git
|
||||
itself.
|
||||
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, 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);
|
||||
|
||||
Reference in New Issue
Block a user