use strict;
use warnings;
-# very loose regexes, here. We don't need RFC-compliance,
-# just enough to make thing sanely displayable and pass to git
+sub xs_emails { map { $_->address() } parse_email_addresses($_[0]) }
-sub emails {
- ($_[0] =~ /([\w\.\+=\?"\(\)\-!#\$%&'\*\/\^\`\|\{\}~]+\@[\w\.\-\(\)]+)
- (?:\s[^>]*)?>?\s*(?:\(.*?\))?(?:,\s*|\z)/gx)
+sub xs_names {
+ map {
+ my $n = $_->name;
+ $n = $_->user if $n eq $_->address;
+ $n;
+ } parse_email_addresses($_[0]);
}
-sub names {
- my @p = split(/<?([^@<>]+)\@[\w\.\-]+>?\s*(\(.*?\))?(?:,\s*|\z)/,
- $_[0]);
- my @ret;
- for (my $i = 0; $i <= $#p;) {
- my $phrase = $p[$i++];
- $phrase =~ tr/\r\n\t / /s;
- $phrase =~ s/\A['"\s]*//;
- $phrase =~ s/['"\s]*\z//;
- my $user = $p[$i++] // '';
- my $comment = $p[$i++] // '';
- if ($phrase =~ /\S/) {
- $phrase =~ s/\@\S+\z//;
- push @ret, $phrase;
- } elsif ($comment =~ /\A\((.*?)\)\z/) {
- push @ret, $1;
- } else {
- push @ret, $user;
- }
- }
- @ret;
+eval {
+ require Email::Address::XS;
+ Email::Address::XS->import(qw(parse_email_addresses));
+ *emails = \&xs_emails;
+ *names = \&xs_names;
+};
+
+if ($@) {
+ require PublicInbox::AddressPP;
+ *emails = \&PublicInbox::AddressPP::emails;
+ *names = \&PublicInbox::AddressPP::names;
}
1;
--- /dev/null
+# Copyright (C) 2016-2019 all contributors <meta@public-inbox.org>
+# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
+package PublicInbox::AddressPP;
+use strict;
+
+# very loose regexes, here. We don't need RFC-compliance,
+# just enough to make thing sanely displayable and pass to git
+# We favor Email::Address::XS for conformance if available
+
+sub emails {
+ ($_[0] =~ /([\w\.\+=\?"\(\)\-!#\$%&'\*\/\^\`\|\{\}~]+\@[\w\.\-\(\)]+)
+ (?:\s[^>]*)?>?\s*(?:\(.*?\))?(?:,\s*|\z)/gx)
+}
+
+sub names {
+ my @p = split(/<?([^@<>]+)\@[\w\.\-]+>?\s*(\(.*?\))?(?:,\s*|\z)/,
+ $_[0]);
+ my @ret;
+ for (my $i = 0; $i <= $#p;) {
+ my $phrase = $p[$i++];
+ $phrase =~ tr/\r\n\t / /s;
+ $phrase =~ s/\A['"\s]*//;
+ $phrase =~ s/['"\s]*\z//;
+ my $user = $p[$i++] // '';
+ my $comment = $p[$i++] // '';
+ if ($phrase =~ /\S/) {
+ $phrase =~ s/\@\S+\z//;
+ push @ret, $phrase;
+ } elsif ($comment =~ /\A\((.*?)\)\z/) {
+ push @ret, $1;
+ } else {
+ push @ret, $user;
+ }
+ }
+ @ret;
+}
+
+1;
use Test::More;
use_ok 'PublicInbox::Address';
-is_deeply([qw(e@example.com e@example.org)],
- [PublicInbox::Address::emails('User <e@example.com>, e@example.org')],
- 'address extraction works as expected');
-
-is_deeply(['user@example.com'],
- [PublicInbox::Address::emails('<user@example.com (Comment)>')],
- 'comment after domain accepted before >');
-
-my @names = PublicInbox::Address::names(
- 'User <e@e>, e@e, "John A. Doe" <j@d>, <x@x>, <y@x> (xyz), '.
- 'U Ser <u@x> (do not use)');
-is_deeply(\@names, ['User', 'e', 'John A. Doe', 'x', 'xyz', 'U Ser'],
- 'name extraction works as expected');
-
-@names = PublicInbox::Address::names('"user@example.com" <user@example.com>');
-is_deeply(['user'], \@names, 'address-as-name extraction works as expected');
-
-
-{
- my $backwards = 'u@example.com (John Q. Public)';
- @names = PublicInbox::Address::names($backwards);
- is_deeply(\@names, ['John Q. Public'], 'backwards name OK');
- my @emails = PublicInbox::Address::emails($backwards);
- is_deeply(\@emails, ['u@example.com'], 'backwards emails OK');
+sub test_pkg {
+ my ($pkg) = @_;
+ my $emails = \&{"${pkg}::emails"};
+ my $names = \&{"${pkg}::names"};
+
+ is_deeply([qw(e@example.com e@example.org)],
+ [$emails->('User <e@example.com>, e@example.org')],
+ 'address extraction works as expected');
+
+ is_deeply(['user@example.com'],
+ [$emails->('<user@example.com (Comment)>')],
+ 'comment after domain accepted before >');
+
+ my @names = $names->(
+ 'User <e@e>, e@e, "John A. Doe" <j@d>, <x@x>, <y@x> (xyz), '.
+ 'U Ser <u@x> (do not use)');
+ is_deeply(\@names, ['User', 'e', 'John A. Doe', 'x', 'xyz', 'U Ser'],
+ 'name extraction works as expected');
+
+ @names = $names->('"user@example.com" <user@example.com>');
+ is_deeply(['user'], \@names,
+ 'address-as-name extraction works as expected');
+
+ {
+ my $backwards = 'u@example.com (John Q. Public)';
+ @names = $names->($backwards);
+ is_deeply(\@names, ['John Q. Public'], 'backwards name OK');
+ my @emails = $emails->($backwards);
+ is_deeply(\@emails, ['u@example.com'], 'backwards emails OK');
+ }
+
+ @names = $names->('"Quote Unneeded" <user@example.com>');
+ is_deeply(['Quote Unneeded'], \@names, 'extra quotes dropped');
}
+test_pkg('PublicInbox::Address');
-@names = PublicInbox::Address::names('"Quote Unneeded" <user@example.com>');
-is_deeply(['Quote Unneeded'], \@names, 'extra quotes dropped');
+SKIP: {
+ if ($INC{'PublicInbox/AddressPP.pm'}) {
+ skip 'Email::Address::XS missing', 8;
+ }
+ use_ok 'PublicInbox::AddressPP';
+ test_pkg('PublicInbox::AddressPP');
+}
done_testing;