send-email: reduce dependencies impact on parse_address_line

parse_address_line had not the same behavior whether the user had Mail::Address or not. Teach parse_address_line to behave like Mail::Address. When the user input is correct, this implementation behaves exactly like Mail::Address except when there are quotes inside the name: "Jane Do"e <jdoe@example.com> In this case the result of parse_address_line is: With M::A : "Jane Do" e <jdoe@example.com> Without : "Jane Do e" <jdoe@example.com> When the user input is not correct, the behavior is also mostly the same. Unlike Mail::Address, this doesn't parse groups and recursive commentaries. Signed-off-by: Remi Lespinet <remi.lespinet@ensimag.grenoble-inp.fr> Signed-off-by: Matthieu Moy <Matthieu.Moy@imag.fr> Signed-off-by: Junio C Hamano <gitster@pobox.com>

Remi Lespinet committed Jul 7, 2015 at 15:38 UTC 8d314d7afec5adaaa8e22332e39fe84a39584653
4 files changed +162 -1
git-send-email.perl
+1 -1
@@ -478,7 +478,7 @@ sub parse_address_line {
478 if ($have_mail_address) {
479 return map { $_->format } Mail::Address->parse($_[0]);
480 } else {
481 - return split_addrs($_[0]);
481 + return Git::parse_mailboxes($_[0]);
482 }
483 }
484
perl/Git.pm
+67
@@ -864,6 +864,73 @@ sub ident_person {
864 return "$ident[0] <$ident[1]>";
865 }
866
867 +=item parse_mailboxes
868 +
869 +Return an array of mailboxes extracted from a string.
870 +
871 +=cut
872 +
873 +sub parse_mailboxes {
874 + my $re_comment = qr/\((?:[^)]*)\)/;
875 + my $re_quote = qr/"(?:[^\"\\]|\\.)*"/;
876 + my $re_word = qr/(?:[^]["\s()<>:;@\\,.]|\\.)+/;
877 +
878 + # divide the string in tokens of the above form
879 + my $re_token = qr/(?:$re_quote|$re_word|$re_comment|\S)/;
880 + my @tokens = map { $_ =~ /\s*($re_token)\s*/g } @_;
881 +
882 + # add a delimiter to simplify treatment for the last mailbox
883 + push @tokens, ",";
884 +
885 + my (@addr_list, @phrase, @address, @comment, @buffer) = ();
886 + foreach my $token (@tokens) {
887 + if ($token =~ /^[,;]$/) {
888 + # if buffer still contains undeterminated strings
889 + # append it at the end of @address or @phrase
890 + if (@address) {
891 + push @address, @buffer;
892 + } else {
893 + push @phrase, @buffer;
894 + }
895 +
896 + my $str_phrase = join ' ', @phrase;
897 + my $str_address = join '', @address;
898 + my $str_comment = join ' ', @comment;
899 +
900 + # quote are necessary if phrase contains
901 + # special characters
902 + if ($str_phrase =~ /[][()<>:;@\\,.\000-\037\177]/) {
903 + $str_phrase =~ s/(^|[^\\])"/$1/g;
904 + $str_phrase = qq["$str_phrase"];
905 + }
906 +
907 + # add "<>" around the address if necessary
908 + if ($str_address ne "" && $str_phrase ne "") {
909 + $str_address = qq[<$str_address>];
910 + }
911 +
912 + my $str_mailbox = "$str_phrase $str_address $str_comment";
913 + $str_mailbox =~ s/^\s*|\s*$//g;
914 + push @addr_list, $str_mailbox if ($str_mailbox);
915 +
916 + @phrase = @address = @comment = @buffer = ();
917 + } elsif ($token =~ /^\(/) {
918 + push @comment, $token;
919 + } elsif ($token eq "<") {
920 + push @phrase, (splice @address), (splice @buffer);
921 + } elsif ($token eq ">") {
922 + push @address, (splice @buffer);
923 + } elsif ($token eq "@") {
924 + push @address, (splice @buffer), "@";
925 + } elsif ($token eq ".") {
926 + push @address, (splice @buffer), ".";
927 + } else {
928 + push @buffer, $token;
929 + }
930 + }
931 +
932 + return @addr_list;
933 +}
934
935 =item hash_object ( TYPE, FILENAME )
936
t/t9000-addresses.sh new
+27
@@ -0,0 +1,27 @@
1 +#!/bin/sh
2 +
3 +test_description='compare address parsing with and without Mail::Address'
4 +. ./test-lib.sh
5 +
6 +if ! test_have_prereq PERL; then
7 + skip_all='skipping perl interface tests, perl not available'
8 + test_done
9 +fi
10 +
11 +perl -MTest::More -e 0 2>/dev/null || {
12 + skip_all="Perl Test::More unavailable, skipping test"
13 + test_done
14 +}
15 +
16 +perl -MMail::Address -e 0 2>/dev/null || {
17 + skip_all="Perl Mail::Address unavailable, skipping test"
18 + test_done
19 +}
20 +
21 +test_external_has_tap=1
22 +
23 +test_external_without_stderr \
24 + 'Perl address parsing function' \
25 + perl "$TEST_DIRECTORY"/t9000/test.pl
26 +
27 +test_done
t/t9000/test.pl new
+67
@@ -0,0 +1,67 @@
1 +#!/usr/bin/perl
2 +use lib (split(/:/, $ENV{GITPERLLIB}));
3 +
4 +use 5.008;
5 +use warnings;
6 +use strict;
7 +
8 +use Test::More qw(no_plan);
9 +use Mail::Address;
10 +
11 +BEGIN { use_ok('Git') }
12 +
13 +my @success_list = (q[Jane],
14 + q[jdoe@example.com],
15 + q[<jdoe@example.com>],
16 + q[Jane <jdoe@example.com>],
17 + q[Jane Doe <jdoe@example.com>],
18 + q["Jane" <jdoe@example.com>],
19 + q["Doe, Jane" <jdoe@example.com>],
20 + q["Jane@:;\>.,()<Doe" <jdoe@example.com>],
21 + q[Jane!#$%&'*+-/=?^_{|}~Doe' <jdoe@example.com>],
22 + q["<jdoe@example.com>"],
23 + q["Jane jdoe@example.com"],
24 + q[Jane Doe <jdoe @ example.com >],
25 + q[Jane Doe < jdoe@example.com >],
26 + q[Jane @ Doe @ Jane @ Doe],
27 + q["Jane, 'Doe'" <jdoe@example.com>],
28 + q['Doe, "Jane' <jdoe@example.com>],
29 + q["Jane" "Do"e <jdoe@example.com>],
30 + q["Jane' Doe" <jdoe@example.com>],
31 + q["Jane Doe <jdoe@example.com>" <jdoe@example.com>],
32 + q["Jane\" Doe" <jdoe@example.com>],
33 + q[Doe, jane <jdoe@example.com>],
34 + q["Jane Doe <jdoe@example.com>],
35 + q['Jane 'Doe' <jdoe@example.com>]);
36 +
37 +my @known_failure_list = (q[Jane\ Doe <jdoe@example.com>],
38 + q["Doe, Ja"ne <jdoe@example.com>],
39 + q["Doe, Katarina" Jane <jdoe@example.com>],
40 + q[Jane@:;\.,()<>Doe <jdoe@example.com>],
41 + q[Jane jdoe@example.com],
42 + q[<jdoe@example.com> Jane Doe],
43 + q[Jane <jdoe@example.com> Doe],
44 + q["Jane "Kat"a" ri"na" ",Doe" <jdoe@example.com>],
45 + q[Jane Doe],
46 + q[Jane "Doe <jdoe@example.com>"],
47 + q[\"Jane Doe <jdoe@example.com>],
48 + q[Jane\"\" Doe <jdoe@example.com>],
49 + q['Jane "Katarina\" \' Doe' <jdoe@example.com>]);
50 +
51 +foreach my $str (@success_list) {
52 + my @expected = map { $_->format } Mail::Address->parse("$str");
53 + my @actual = Git::parse_mailboxes("$str");
54 + is_deeply(\@expected, \@actual, qq[same output : $str]);
55 +}
56 +
57 +TODO: {
58 + local $TODO = "known breakage";
59 + foreach my $str (@known_failure_list) {
60 + my @expected = map { $_->format } Mail::Address->parse("$str");
61 + my @actual = Git::parse_mailboxes("$str");
62 + is_deeply(\@expected, \@actual, qq[same output : $str]);
63 + }
64 +}
65 +
66 +my $is_passing = eval { Test::More->is_passing };
67 +exit($is_passing ? 0 : 1) unless $@ =~ /Can't locate object method/;