imap: replace Mail::Address fallback with AddressPP

Our pure-Perl (PublicInbox::AddressPP) fallback is closer to the
preferred Email::Address::XS (EAX) behavior than Mail::Address
is for ->name support.  EAX tends to be overkill with good spam
filtering, and using our own fallback means life is easier for
users with neither C/XS build tools nor a pre-built EAX package.

diff --git a/INSTALL b/INSTALL
index 52bc94473a67358e720934bee1fbe6113c4a030b..c5d69d1b1172bed27a5cbf6b017e5d5506958df7 100644 (file)
--- a/INSTALL
+++ b/INSTALL
@@ -83,8 +83,7 @@ Numerous optional modules are likely to be useful as well:
 - Email::Address::XS               deb: libemail-address-xs-perl
                                    pkg: p5-Email-Address-XS
                                    (correct parsing of tricky email
-                                    addresses, phrases and comments,
-                                    required for IMAP)
+                                    addresses, phrases and comments)
 
 - Parse::RecDescent                deb: libparse-recdescent-perl
                                    pkg: p5-Parse-RecDescent

diff --git a/lib/PublicInbox/Address.pm b/lib/PublicInbox/Address.pm
index 2c9c4395c02edbb86683573612f5b454115ce719..a5902cfd63849634778d6425e41c0cbfc0a238f1 100644 (file)
--- a/lib/PublicInbox/Address.pm
+++ b/lib/PublicInbox/Address.pm
@@ -1,9 +1,8 @@
-# Copyright (C) 2016-2021 all contributors <meta@public-inbox.org>
+# Copyright (C) all contributors <meta@public-inbox.org>
 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
 package PublicInbox::Address;
-use strict;
-use v5.10.1;
-use parent 'Exporter';
+use v5.12;
+use parent qw(Exporter);
 our @EXPORT_OK = qw(pairs);
 
 sub xs_emails {
@@ -31,6 +30,7 @@ eval {
        *emails = \&xs_emails;
        *names = \&xs_names;
        *pairs = \&xs_pairs;
+       *objects = sub { Email::Address::XS->parse(@_) };
 };
 
 if ($@) {
@@ -38,6 +38,7 @@ if ($@) {
        *emails = \&PublicInbox::AddressPP::emails;
        *names = \&PublicInbox::AddressPP::names;
        *pairs = \&PublicInbox::AddressPP::pairs;
+       *objects = \&PublicInbox::AddressPP::objects;
 }
 
 1;

diff --git a/lib/PublicInbox/AddressPP.pm b/lib/PublicInbox/AddressPP.pm
index 6a3ae4fed766d7cb654b1f00ad53b1d798986246..65ba36a95e2f6b8c6731a023a57f2df5f7440d77 100644 (file)
--- a/lib/PublicInbox/AddressPP.pm
+++ b/lib/PublicInbox/AddressPP.pm
@@ -1,7 +1,8 @@
-# Copyright (C) 2016-2021 all contributors <meta@public-inbox.org>
+# Copyright (C) all contributors <meta@public-inbox.org>
 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
 package PublicInbox::AddressPP;
 use strict;
+use v5.10.1; # TODO check regexps for unicode_strings compat
 
 # very loose regexes, here.  We don't need RFC-compliance,
 # just enough to make thing sanely displayable and pass to git
@@ -56,4 +57,13 @@ sub pairs { # for JMAP, RFC 8621 section 4.1.2.3
        } emails($s) ];
 }
 
+# Mail::Address->name is inconsistent with Email::Address::XS, so we're
+# doing our own thing, here:
+sub objects { map { bless $_, __PACKAGE__ } @{pairs($_[0])} }
+
+# OO API for objects() results
+sub user { (split(/@/, $_[0]->[1]))[0] }
+sub host { (split(/@/, $_[0]->[1]))[1] }
+sub name { $_[0]->[0] // user($_[0]) }
+
 1;

diff --git a/lib/PublicInbox/IMAP.pm b/lib/PublicInbox/IMAP.pm
index e4a9e3041806d0615bdef80f2c3e24b79b61b009..b12533cb5f290fb6e88a676df4d26b7f61de495c 100644 (file)
--- a/lib/PublicInbox/IMAP.pm
+++ b/lib/PublicInbox/IMAP.pm
@@ -39,13 +39,7 @@ use PublicInbox::DS qw(now);
 use PublicInbox::GitAsyncCat;
 use Text::ParseWords qw(parse_line);
 use Errno qw(EAGAIN);
-
-my $Address;
-for my $mod (qw(Email::Address::XS Mail::Address)) {
-       eval "require $mod" or next;
-       $Address = $mod and last;
-}
-die "neither Email::Address::XS nor Mail::Address loaded: $@" if !$Address;
+use PublicInbox::Address;
 
 sub LINE_MAX () { 8000 } # RFC 2683 3.2.1.5
 
@@ -438,7 +432,7 @@ sub addr_envelope ($$;$) {
        my $v = $eml->header_raw($x) //
                ($y ? $eml->header_raw($y) : undef) // return 'NIL';
 
-       my @x = $Address->parse($v) or return 'NIL';
+       my @x = PublicInbox::Address::objects($v) or return 'NIL';
        '(' . join('',
                map { '(' . join(' ',
                                _esc($_->name), 'NIL',

diff --git a/lib/PublicInbox/TestCommon.pm b/lib/PublicInbox/TestCommon.pm
index f2914d09673f827aef69df9f01d68d51120430aa..5f123eb422cc395be040fada143fe058f610b3b3 100644 (file)
--- a/lib/PublicInbox/TestCommon.pm
+++ b/lib/PublicInbox/TestCommon.pm
@@ -196,8 +196,7 @@ sub require_mods {
                        push @mods, qw(Plack::Builder Plack::Util);
                        next;
                } elsif ($mod eq '-imapd') {
-                       push @mods, qw(Parse::RecDescent DBD::SQLite
-                                       Email::Address::XS||Mail::Address);
+                       push @mods, qw(Parse::RecDescent DBD::SQLite);
                        next;
                } elsif ($mod eq '-nntpd' || $mod eq 'v2') {
                        push @mods, qw(DBD::SQLite);

diff --git a/t/address.t b/t/address.t
index 6aa94628dc8f943cccf1bf626e39098b87d49ad5..16000d2d55a5af69c04f4351c465ff54ccbecd17 100644 (file)
--- a/t/address.t
+++ b/t/address.t
@@ -1,7 +1,7 @@
-# Copyright (C) 2016-2021 all contributors <meta@public-inbox.org>
+#!perl -w
+# Copyright (C) all contributors <meta@public-inbox.org>
 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
-use strict;
-use warnings;
+use v5.12;
 use Test::More;
 use_ok 'PublicInbox::Address';
 
@@ -10,6 +10,7 @@ sub test_pkg {
        my $emails = $pkg->can('emails');
        my $names = $pkg->can('names');
        my $pairs = $pkg->can('pairs');
+       my $objects = $pkg->can('objects');
 
        is_deeply([qw(e@example.com e@example.org)],
                [$emails->('User <e@example.com>, e@example.org')],
@@ -35,6 +36,18 @@ sub test_pkg {
                        [ 'xyz', 'y@x' ], [ 'U Ser', 'u@x' ] ],
                "pairs extraction works for $pkg");
 
+       # only what's used by PublicInbox::IMAP:
+       my @objs = $objects->($s);
+       my @exp = (qw(User e e), qw(e e e), ('John A. Doe', qw(j d)),
+               qw(x x x), qw(xyz y x), ('U Ser', qw(u x)));
+       for (my $i = 0; $i <= $#objs; $i++) {
+               my $exp_name = shift @exp;
+               my $name = $objs[$i]->name;
+               is $name, $exp_name, "->name #$i matches";
+               is $objs[$i]->user, shift @exp, "->user #$i matches";
+               is $objs[$i]->host , shift @exp, "->host #$i matches";
+       }
+
        @names = $names->('"user@example.com" <user@example.com>');
        is_deeply(['user'], \@names,
                'address-as-name extraction works as expected');