[PATCH/RFC v4 07/10] send-email: reduce dependancies impact on parse_address_line

[Remi Lespinet]

> Remi Lespinet <remi.lespi...@ensimag.grenoble-inp.fr> writes:
> 
> > I've some more tests, maybe I should put them all in this post ?
> 
> Yes, please post as much as you have. Ideally, this should be
> automatically tested, but if you don't have time to write the automated
> tests, at least having a track of what you did on the list archives can
> help someone else to do it.

It may not be easily readable without colors, so there are the scripts
at the end. You can change the tested input by changing lines after
the "cat >.tmplist" line in testall.sh. (There are two scripts 
testall.sh and testone.perl).

Here are the tests results:

Input: 
Split: 
M::A : 
Same : Yes
----------
Input: Jane
Split: Jane
M::A : Jane
Same : Yes
----------
Input: j...@example.com
Split: j...@example.com
M::A : j...@example.com
Same : Yes
----------
Input: <j...@example.com>
Split: j...@example.com
M::A : j...@example.com
Same : Yes
----------
Input: Jane <j...@example.com>
Split: Jane <j...@example.com>
M::A : Jane <j...@example.com>
Same : Yes
----------
Input: Jane Doe <j...@example.com>
Split: Jane Doe <j...@example.com>
M::A : Jane Doe <j...@example.com>
Same : Yes
----------
Input: Jane\ Doe <j...@example.com>
Split: "Jane\ Doe" <j...@example.com>
M::A : "Jane \ Doe" <j...@example.com>
Same : No
----------
Input: "Jane" <j...@example.com>
Split: "Jane" <j...@example.com>
M::A : "Jane" <j...@example.com>
Same : Yes
----------
Input: "Doe, Jane" <j...@example.com>
Split: "Doe, Jane" <j...@example.com>
M::A : "Doe, Jane" <j...@example.com>
Same : Yes
----------
Input: "Doe, Ja"ne <j...@example.com>
Split: "Doe, Ja ne" <j...@example.com>
M::A : "Doe, Ja" ne <j...@example.com>
Same : No
----------
Input: "Doe, Katarina" Jane <j...@example.com>
Split: "Doe, Katarina Jane" <j...@example.com>
M::A : "Doe, Katarina" Jane <j...@example.com>
Same : No
----------
Input: "Jane@:;\>.,()<Doe" <j...@example.com>
Split: "Jane@:;\>.,()<Doe" <j...@example.com>
M::A : "Jane@:;\>.,()<Doe" <j...@example.com>
Same : Yes
----------
Input: Jane@:;\.,()<>Doe <j...@example.com>
Split: Jane@:
     : "\."
     : Doe <j...@example.com> ()
M::A : Jane@:
     : \.
     : Doe <j...@example.com> ()
Same : No
----------
Input: Jane!#$%&'*+-/=?^_{|}~Doe' <j...@example.com>
Split: Jane!#$%&'*+-/=?^_{|}~Doe' <j...@example.com>
M::A : Jane!#$%&'*+-/=?^_{|}~Doe' <j...@example.com>
Same : Yes
----------
Input: "<j...@example.com>"
Split: "<j...@example.com>"
M::A : "<j...@example.com>"
Same : Yes
----------
Input: "Jane j...@example.com"
Split: "Jane j...@example.com"
M::A : "Jane j...@example.com"
Same : Yes
----------
Input: Jane Doe <jdoe    @   example.com  >
Split: Jane Doe <j...@example.com>
M::A : Jane Doe <j...@example.com>
Same : Yes
----------
Input: Jane       Doe <  j...@example.com  >
Split: Jane Doe <j...@example.com>
M::A : Jane Doe <j...@example.com>
Same : Yes
----------
Input: Jane @ Doe @ Jane @ Doe
Split: Jane@Doe@Jane@Doe
M::A : Jane@Doe@Jane@Doe
Same : Yes
----------
Input: Jane j...@example.com
Split: janej...@example.com
M::A : Jane
     : j...@example.com
Same : No
----------
Input: <j...@example.com> Jane Doe
Split: jdoe@example.comJaneDoe
M::A : Jane Doe <j...@example.com>
Same : No
----------
Input: Jane <j...@example.com> Doe
Split: Jane <jdoe@example.comDoe>
M::A : Jane Doe <j...@example.com>
Same : No
----------
Input: "Jane, 'Doe'" <j...@example.com>
Split: "Jane, 'Doe'" <j...@example.com>
M::A : "Jane, 'Doe'" <j...@example.com>
Same : Yes
----------
Input: 'Doe, "Jane' <j...@example.com>
Split: 'Doe
     : " Jane' <j...@example.com>
M::A : 'Doe
     : " Jane' <j...@example.com>
Same : Yes
----------
Input: "Jane" "Do"e <j...@example.com>
Split: "Jane" "Do" e <j...@example.com>
M::A : "Jane" "Do" e <j...@example.com>
Same : Yes
----------
Input: "Jane' Doe" <j...@example.com>
Split: "Jane' Doe" <j...@example.com>
M::A : "Jane' Doe" <j...@example.com>
Same : Yes
----------
Input: "Jane Doe <j...@example.com>" <j...@example.com>
Split: "Jane Doe <j...@example.com>" <j...@example.com>
M::A : "Jane Doe <j...@example.com>" <j...@example.com>
Same : Yes
----------
Input: "Jane\" Doe" <j...@example.com>
Split: "Jane\" Doe" <j...@example.com>
M::A : "Jane\" Doe" <j...@example.com>
Same : Yes
----------
Input: Doe, jane <j...@example.com>
Split: Doe
     : jane <j...@example.com>
M::A : Doe
     : jane <j...@example.com>
Same : Yes
----------
Input: "Jane Doe <j...@example.com>
Split: " Jane Doe <j...@example.com>
M::A : " Jane Doe <j...@example.com>
Same : Yes
----------
Input: "Jane "Kat"a" ri"na" ",Doe" <j...@example.com>
Split: "Jane  Kat a ri na ,Doe" <j...@example.com>
M::A : "Jane " Kat "a" ri "na" ",Doe" <j...@example.com>
Same : No
----------
Input: Jane Doe
Split: Jane Doe
M::A : Jane
     : Doe
Same : No
----------
Input: Jane "Doe <j...@example.com>"
Split: "Jane Doe <j...@example.com>"
M::A : Jane
     : "Doe <j...@example.com>"
Same : No
----------
Input: \"Jane Doe <j...@example.com>
Split: "\"Jane Doe" <j...@example.com>
M::A : \ " Jane Doe <j...@example.com>
Same : No
----------
Input: Jane\"\" Doe <j...@example.com>
Split: "Jane\"\" Doe" <j...@example.com>
M::A : Jane \ " \ " Doe <j...@example.com>
Same : No
----------
Input: 'Jane 'Doe' <j...@example.com>
Split: 'Jane 'Doe' <j...@example.com>
M::A : 'Jane 'Doe' <j...@example.com>
Same : Yes
----------
Input: 'Jane "Katarina\" \' Doe' <j...@example.com>
Split: "'Jane  Katarina\" \' Doe'" <j...@example.com>
M::A : 'Jane " Katarina \ " \ ' Doe' <j...@example.com>
Same : No


**********************************************************************
*                          SCRIPTS PART                              *
**********************************************************************


---------------------------- testall.sh ----------------------------

#!/bin/sh

cat >.tmplist <<EOF

Jane
j...@example.com
<j...@example.com>
Jane <j...@example.com>
Jane Doe <j...@example.com>
Jane\ Doe <j...@example.com>
"Jane" <j...@example.com>
"Doe, Jane" <j...@example.com>
"Doe, Ja"ne <j...@example.com>
"Doe, Katarina" Jane <j...@example.com>
"Jane@:;\>.,()<Doe" <j...@example.com>
Jane@:;\.,()<>Doe <j...@example.com>
Jane!#$%&'*+-/=?^_{|}~Doe' <j...@example.com>
"<j...@example.com>"
"Jane j...@example.com"
Jane Doe <jdoe    @   example.com  >
Jane       Doe <  j...@example.com  >
Jane @ Doe @ Jane @ Doe
Jane j...@example.com
<j...@example.com> Jane Doe
Jane <j...@example.com> Doe
"Jane, 'Doe'" <j...@example.com>
'Doe, "Jane' <j...@example.com>
"Jane" "Do"e <j...@example.com>
"Jane' Doe" <j...@example.com>
"Jane Doe <j...@example.com>" <j...@example.com>
"Jane\" Doe" <j...@example.com>
Doe, jane <j...@example.com>
"Jane Doe <j...@example.com>
"Jane "Kat"a" ri"na" ",Doe" <j...@example.com>
Jane Doe
Jane "Doe <j...@example.com>"
\"Jane Doe <j...@example.com>
Jane\"\" Doe <j...@example.com>
'Jane 'Doe' <j...@example.com>
'Jane "Katarina\" \' Doe' <j...@example.com>
EOF


cat .tmplist | while read -r line
do
    echo "Input: $line"
    ./testone.perl "$line"
    echo ----------
done

---------------------------- testone.perl ----------------------------

#!/usr/bin/perl

use strict;
use warnings;

use Term::ANSIColor;
use Mail::Address;
use Text::ParseWords;

my $string = $ARGV[0];

sub split_addrs {
        my $re_comment = qr/\((?:[^)]*)\)/;
        my $re_quote = qr/"(?:[^\"\\]|\\.)*"/;
        my $re_word = qr/(?:[^]["\s()<>:;@\\,.]|\\.)+/;
        my $re_token = qr/(?:$re_quote|$re_word|$re_comment|\S)/;

        my @tokens = map { $_ =~ /\s*($re_token)\s*/g } @_;
        push @tokens, ",";

        my (@addr_list, @phrase, @address, @comment, @buffer) = ();
        foreach my $token (@tokens) {
                if ($token =~ /^[,;]$/) {
                        if (@address) {
                                push @address, @buffer;
                        } else {
                                push @phrase, @buffer;
                        }
                
                        my $str_phrase = join ' ', @phrase;
                        my $str_address = join '', @address;
                        my $str_comment = join ' ', @comment;
                
                        if ($str_phrase =~ /[][()<>:;@\\,.\000-\037\177]/) {
                                $str_phrase =~ s/(^|[^\\])"/$1/g;
                                $str_phrase = qq["$str_phrase"];
                        }
                
                        if ($str_address ne "" && $str_phrase ne "") {
                                $str_address = qq[<$str_address>];
                        }
                
                        my $str_mailbox = "$str_phrase $str_address 
$str_comment";
                        $str_mailbox =~ s/^\s*|\s*$//g;
                        push @addr_list, $str_mailbox if ($str_mailbox);
                
                        @phrase = @address = @comment = @buffer = ();
                } elsif ($token =~ /^\(/) {
                        push @comment, $token;
                } elsif ($token eq "<") {
                        push @phrase, (splice @address), (splice @buffer);
                } elsif ($token eq ">") {
                        push @address, (splice @buffer);
                } elsif ($token eq "@") {
                        push @address, (splice @buffer), "@";
                } elsif ($token eq ".") {
                        push @address, (splice @buffer), ".";
                } else {
                        push @buffer, $token;
                }
        }

        return @addr_list;
}

sub old_split {
        quotewords('\s*,\s*', 1, $_[0]);
}

my @tab = split_addrs($string);
my @ref = map { $_->format } Mail::Address->parse($string);
# my @old = old_split($string);  #can be printed to see the difference

my $tabstring = join "\n", @tab;
my $refstring = join "\n", @ref;
my $same = ($tabstring eq $refstring);

$tabstring =~ s/\n/\n     : /g;
$refstring =~ s/\n/\n     : /g;

print color 'bold yellow';
print "Split: ", "$tabstring", "\n";

print color 'bold blue';
print "M::A : ", "$refstring", "\n";

if ($same) {
        print color 'bold green';
        print "Same : ", "Yes", "\n";
} else {
        print color 'bold red';
        print "Same : ", "No", "\n";
}

print color 'reset';


 
--
To unsubscribe from this list: send the line "unsubscribe git" in
the body of a message to majord...@vger.kernel.org
More majordomo info at  http://vger.kernel.org/majordomo-info.html