]> Sergey Matveev's repositories - public-inbox.git/blob - t/address.t
viewvcs: expand on path names being "non-authoritative"
[public-inbox.git] / t / address.t
1 # Copyright (C) 2016-2021 all contributors <meta@public-inbox.org>
2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
3 use strict;
4 use warnings;
5 use Test::More;
6 use_ok 'PublicInbox::Address';
7
8 sub test_pkg {
9         my ($pkg) = @_;
10         my $emails = $pkg->can('emails');
11         my $names = $pkg->can('names');
12         my $pairs = $pkg->can('pairs');
13
14         is_deeply([qw(e@example.com e@example.org)],
15                 [$emails->('User <e@example.com>, e@example.org')],
16                 'address extraction works as expected');
17
18         is_deeply($pairs->('User <e@example.com>, e@example.org'),
19                         [[qw(User e@example.com)], [undef, 'e@example.org']],
20                 "pair extraction works ($pkg)");
21
22         is_deeply(['user@example.com'],
23                 [$emails->('<user@example.com (Comment)>')],
24                 'comment after domain accepted before >');
25         is_deeply($pairs->('<user@example.com (Comment)>'),
26                 [[qw(Comment user@example.com)]], "comment as name ($pkg)");
27
28         my $s = 'User <e@e>, e@e, "John A. Doe" <j@d>, <x@x>, <y@x> (xyz), '.
29                 'U Ser <u@x> (do not use)';
30         my @names = $names->($s);
31         is_deeply(\@names, ['User', 'e', 'John A. Doe', 'x', 'xyz', 'U Ser'],
32                 'name extraction works as expected');
33         is_deeply($pairs->($s), [ [ 'User', 'e@e' ], [ undef, 'e@e' ],
34                         [ 'John A. Doe', 'j@d' ], [ undef, 'x@x' ],
35                         [ 'xyz', 'y@x' ], [ 'U Ser', 'u@x' ] ],
36                 "pairs extraction works for $pkg");
37
38         @names = $names->('"user@example.com" <user@example.com>');
39         is_deeply(['user'], \@names,
40                 'address-as-name extraction works as expected');
41         is_deeply($pairs->('"user@example.com" <user@example.com>'),
42                 [ [ 'user@example.com', 'user@example.com' ] ],
43                 "pairs for $pkg");
44
45         {
46                 my $backwards = 'u@example.com (John Q. Public)';
47                 @names = $names->($backwards);
48                 is_deeply(\@names, ['John Q. Public'], 'backwards name OK');
49                 my @emails = $emails->($backwards);
50                 is_deeply(\@emails, ['u@example.com'], 'backwards emails OK');
51
52                 is_deeply($pairs->($backwards),
53                         [ [ 'John Q. Public', 'u@example.com' ] ],
54                         "backwards pairs $pkg");
55         }
56
57         $s = '"Quote Unneeded" <user@example.com>';
58         @names = $names->($s);
59         is_deeply(['Quote Unneeded'], \@names, 'extra quotes dropped');
60         is_deeply($pairs->($s), [ [ 'Quote Unneeded', 'user@example.com' ] ],
61                 "extra quotes dropped in pairs $pkg");
62
63         my @emails = $emails->('Local User <user>');
64         is_deeply([], \@emails , 'no address for local address');
65         @names = $emails->('Local User <user>');
66         is_deeply([], \@names, 'no address, no name');
67 }
68
69 test_pkg('PublicInbox::Address');
70
71 SKIP: {
72         if ($INC{'PublicInbox/AddressPP.pm'}) {
73                 skip 'Email::Address::XS missing', 8;
74         }
75         use_ok 'PublicInbox::AddressPP';
76         test_pkg('PublicInbox::AddressPP');
77 }
78
79 done_testing;