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->('"u...@example.com" <u...@example.com>');
is_deeply(['user'], \@names,
'address-as-name extraction works as expected');
