[PATCH] imap: replace Mail::Address fallback with AddressPP

[PATCH] imap: replace Mail::Address fallback with AddressPP

[Eric Wong]

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.
---
 INSTALL                       |  3 +--
 lib/PublicInbox/Address.pm    |  9 +++++----
 lib/PublicInbox/AddressPP.pm  | 12 +++++++++++-
 lib/PublicInbox/IMAP.pm       | 10 ++--------
 lib/PublicInbox/TestCommon.pm |  3 +--
 t/address.t                   | 19 ++++++++++++++++---
 6 files changed, 36 insertions(+), 20 deletions(-)

diff --git a/INSTALL b/INSTALL
index 52bc9447..c5d69d1b 100644
--- 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 2c9c4395..a5902cfd 100644
--- 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 6a3ae4fe..65ba36a9 100644
--- 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 e4a9e304..b12533cb 100644
--- 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 f2914d09..5f123eb4 100644
--- 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 6aa94628..16000d2d 100644
--- 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');