Skip to content

Allow domainless addresses #9

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
alexmv wants to merge 6 commits into
base: main
Choose a base branch
from
Open

Allow domainless addresses #9

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
a63e67e
Remove trailing whitespace
alexmv Aug 6, 2010
2e4e71c
Remove duplicate test
alexmv Nov 29, 2010
df634c5
Compare as_string to ->as_string, not ->as_string to ->format
alexmv Feb 20, 2014
a884048
Use consistent indentation
alexmv Feb 20, 2014
68a6a40
Test to ensure that the expected number of addresses are returned
alexmv Feb 20, 2014
fe1a79f
Allow domainless addresses, which only have a local part
alexmv Nov 29, 2010
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
55 changes: 43 additions & 12 deletions lib/Email/Address.pm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -132,6 +132,11 @@ our $angle_addr = qr/$cfws*<$addr_spec>$cfws*/;
our $name_addr = qr/$display_name?$angle_addr/;
our $mailbox = qr/(?:$name_addr|$addr_spec)$comment*/;

our $addr_spec_domainless = qr/$local_part(?:\@$domain)?/;
our $angle_addr_domainless = qr/$cfws*<$addr_spec_domainless>$cfws*/;
our $name_addr_domainless = qr/$display_name?$angle_addr_domainless/;
our $mailbox_domainless = qr/(?:$name_addr_domainless|$addr_spec_domainless)$comment*/;

sub _PHRASE () { 0 }
sub _ADDRESS () { 1 }
sub _COMMENT () { 2 }
Expand Down Expand Up @@ -171,6 +176,17 @@ In accordance with RFC 822 and its descendants, this module demands that email
addresses be ASCII only. Any non-ASCII content in the parsed addresses will
cause the parser to return no results.

=item parse_allow_domainless

my @addrs = Email::Address->parse_allow_domainless(
q[me, Casey <me>, "Casey" <me> (West)]
);

This method returns a list of C<Email::Address> objects it finds in the
input string; it differs from L</parse> in that it allows "domainless"
addresses, which lack an at-sign and domain name. The domain of the
addresses is presumed to be assumable by the calling code.

=cut

our (%PARSE_CACHE, %FORMAT_CACHE, %NAME_CACHE);
Expand All @@ -193,17 +209,19 @@ sub __cache_parse {
$PARSE_CACHE{$line} = $addrs;
}

sub parse {
my ($class, $line) = @_;
sub __parse {
my ($class, $line, $domainless) = @_;
return unless $line;

$line =~ s/[ \t]+/ /g if $COLLAPSE_SPACES;

if (my @cached = $class->__get_cached_parse($line)) {
my $key = "$domainless,$line";
if (my @cached = $class->__get_cached_parse($key)) {
return @cached;
}

my (@mailboxes) = ($line =~ /$mailbox/go);
my (@mailboxes) = $domainless ? ($line =~ /$mailbox_domainless/go)
: ($line =~ /$mailbox/go);
my @addrs;
foreach (@mailboxes) {
my $original = $_;
Expand All @@ -212,14 +230,15 @@ sub parse {
s/$comment//go if @comments;

my ($user, $host, $com);
($user, $host) = ($1, $2) if s/<($local_part)\@($domain)>//o;
if (! defined($user) || ! defined($host)) {
s/($local_part)\@($domain)//o;
($user, $host) = ($1, $2) if s/<($local_part)(?:\@($domain))?>//o;
if (not defined($user) or (not defined($host) and $domainless)) {
s/($local_part)(?:\@($domain))?//o;
($user, $host) = ($1, $2);
}
next unless $host or $domainless;

next if $user =~ /\P{ASCII}/;
next if $host =~ /\P{ASCII}/;
next if defined $host and $host =~ /\P{ASCII}/;

my ($phrase) = /($display_name)/o;

Expand All @@ -232,14 +251,26 @@ sub parse {

my $new_comment = join q{ }, @comments;
push @addrs,
$class->new($phrase, "$user\@$host", $new_comment, $original);
$addrs[-1]->[_IN_CACHE] = [ \$line, $#addrs ]
$class->new($phrase, $host ? "$user\@$host" : $user, $new_comment, $original);
$addrs[-1]->[_IN_CACHE] = [ \$key, $#addrs ]
}

$class->__cache_parse($line, \@addrs);
$class->__cache_parse($key, \@addrs);
return @addrs;
}

sub parse {
my $self = shift;
my ($line) = @_;
return $self->__parse($line, 0);
}

sub parse_allow_domainless {
my $self = shift;
my ($line) = @_;
return $self->__parse($line, 1);
}

=item new

my $address = Email::Address->new(undef, 'casey@local');
Expand Down Expand Up @@ -465,7 +496,7 @@ sub name {
$name =~ s/($quoted_pair)/substr $1, -1/goe;
$name =~ s/$comment/ /go;
} else {
($name) = $self->[_ADDRESS] =~ /($local_part)\@/o;
($name) = $self->[_ADDRESS] =~ /($local_part)(?:\@|\Z)/o;
}
$NAME_CACHE{$cache_str} = $name;
}
Expand Down
6 changes: 4 additions & 2 deletions t/patterns.t
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -39,10 +39,12 @@ my %tests = (
[ '"Richard Sonnen" <sonnen@frii.com>', 1 ],
[ '"Richard Sonnen" <sonnen@frii.com> (comments)', 1 ],
[ '', 0 ],
[ 'foo', 0 ],
[ 'foo bar@bar.com', 0 ],
[ '<foo bar>@bar.com', 0 ],
],
mailbox_domainless => [
[ 'foo', 1 ],
],
);

my $num_tests = scalar( map @{$_}, values %tests );
Expand All @@ -55,7 +57,7 @@ my %pats = map {
my $pat;
eval '$pat = $Email::Address::'.$_;
($_ => $pat);
} qw( addr_spec angle_addr name_addr mailbox );
} qw( addr_spec angle_addr name_addr mailbox mailbox_domainless);

for my $pattern_name (keys %tests) {
for my $test (@{ $tests{$pattern_name} }) {
Expand Down
131 changes: 105 additions & 26 deletions t/tests.t
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1584,16 +1584,16 @@ my @list = (
]
]
],
[
'Jason W. May <jmay-- ATAT --x.example.com>',
[
[
'Jason W. May',
'jmay-- ATAT --x.example.com',
undef
]
]
],
[
'Jason W. May <jmay-- ATAT --x.example.com>',
[
[
'Jason W. May',
'jmay-- ATAT --x.example.com',
undef
]
]
],
[
'"Jason W. May" <jmay-- ATAT --x.example.com>, advocacy-- ATAT --p.example.org',
[
Expand All @@ -1618,29 +1618,108 @@ my @list = (
undef,
],
],
]
],
);

my @domain_list = (@list,
[
'jibsheet',
[],
],
[
'alexmv@example.com, jibsheet, jesse@example.com',
[
[
undef,
'alexmv-- ATAT --example.com',
undef,
],
[
undef,
'jesse-- ATAT --example.com',
undef,
],
],
],
);

my @domainless_list = (@list,
[
'falcone',
[
[
undef,
'falcone',
undef
],
]
],
[
'falcone, alexmv',
[
[
undef,
'falcone',
undef
],
[
undef,
'alexmv',
undef
],
]
],
[
'alexmv@example.com, jibsheet, jesse@example.com',
[
[
undef,
'alexmv-- ATAT --example.com',
undef,
],
[
undef,
'jibsheet',
undef,
],
[
undef,
'jesse-- ATAT --example.com',
undef,
],
],
],
);

my $tests = 1;
$tests += @{ $_->[1] } * 5 for @list;
$tests += 1 + @{ $_->[1] } * 5 for @domain_list;
$tests += 1 + @{ $_->[1] } * 5 for @domainless_list;

plan tests => $tests;

use_ok 'Email::Address';

for (@list) {
$_->[0] =~ s/-- ATAT --/@/g;
my @addrs = Email::Address->parse($_->[0]);
my @tests =
map { Email::Address->new(map { $_ ? do {s/-- ATAT --/@/g; $_} : $_ } @$_) }
@{$_->[1]};
for ([parse => \@domain_list], [parse_allow_domainless => \@domainless_list]) {
my ($method,$list) = @$_;
for (@$list) {
my ($string, $expect) = @$_;

$string =~ s/-- ATAT --/@/g;
my @addrs = Email::Address->$method($string);

is(@addrs, @$expect, "got correct number of results from $method {$string}");

my @tests =
map { Email::Address->new(map { s/-- ATAT --/@/g if $_; $_ } @$_) }
@$expect;

foreach (@addrs) {
isa_ok($_, 'Email::Address');
my $test = shift @tests;
is($_->format, $test->format, "format: " . $test->format);
is($_->as_string, $test->format, "format: " . $test->format);
is("$_", $test->format, "stringify: $_");
is($_->name, $test->name, "name: " . $test->name);
}
foreach (@addrs) {
isa_ok($_, 'Email::Address');
my $test = shift @tests;
is($_->format, $test->format, "format: " . $test->format);
is($_->as_string, $test->as_string, "as_string: " . $test->as_string);
is("$_", $test->format, "stringify: $_");
is($_->name, $test->name, "name: " . $test->name);
}
}
}