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;