summaryrefslogtreecommitdiff
path: root/perl/Git/FromCPAN/Mail
diff options
context:
space:
mode:
authorLibravatar Ævar Arnfjörð Bjarmason <avarab@gmail.com>2018-03-03 15:38:15 +0000
committerLibravatar Junio C Hamano <gitster@pobox.com>2018-03-05 10:52:28 -0800
commit382029fc003d400147339573ab5448a88c336f55 (patch)
tree026082960f0defa8fe9060d1ae54d6f6fea7988d /perl/Git/FromCPAN/Mail
parentperl: generalize the Git::LoadCPAN facility (diff)
downloadtgif-382029fc003d400147339573ab5448a88c336f55.tar.xz
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>
Diffstat (limited to 'perl/Git/FromCPAN/Mail')
-rw-r--r--perl/Git/FromCPAN/Mail/Address.pm280
1 files changed, 0 insertions, 280 deletions
diff --git a/perl/Git/FromCPAN/Mail/Address.pm b/perl/Git/FromCPAN/Mail/Address.pm
deleted file mode 100644
index 683d490b2b..0000000000
--- a/perl/Git/FromCPAN/Mail/Address.pm
+++ /dev/null
@@ -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;