From a63e67ea6e3206c7eba04021ae9b749f5edab9e6 Mon Sep 17 00:00:00 2001 From: Alex Vandiver Date: Fri, 6 Aug 2010 16:53:43 -0400 Subject: [PATCH 1/6] Remove trailing whitespace --- t/tests.t | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/t/tests.t b/t/tests.t index 12e4ba2..eb2295c 100644 --- a/t/tests.t +++ b/t/tests.t @@ -1584,16 +1584,16 @@ my @list = ( ] ] ], - [ - 'Jason W. May ', - [ - [ - 'Jason W. May', - 'jmay-- ATAT --x.example.com', - undef - ] - ] - ], + [ + 'Jason W. May ', + [ + [ + 'Jason W. May', + 'jmay-- ATAT --x.example.com', + undef + ] + ] + ], [ '"Jason W. May" , advocacy-- ATAT --p.example.org', [ From 2e4e71ce5129819ee2565c03e329cb3f67e5003a Mon Sep 17 00:00:00 2001 From: Alex Vandiver Date: Mon, 29 Nov 2010 15:28:40 -0500 Subject: [PATCH 2/6] Remove duplicate test --- t/patterns.t | 1 - 1 file changed, 1 deletion(-) diff --git a/t/patterns.t b/t/patterns.t index a85294c..db83ca5 100644 --- a/t/patterns.t +++ b/t/patterns.t @@ -39,7 +39,6 @@ my %tests = ( [ '"Richard Sonnen" ', 1 ], [ '"Richard Sonnen" (comments)', 1 ], [ '', 0 ], - [ 'foo', 0 ], [ 'foo bar@bar.com', 0 ], [ '@bar.com', 0 ], ], From df634c571a6e17ad6ddf70c69112eca216ba3f52 Mon Sep 17 00:00:00 2001 From: Alex Vandiver Date: Wed, 19 Feb 2014 19:14:59 -0500 Subject: [PATCH 3/6] Compare as_string to ->as_string, not ->as_string to ->format --- t/tests.t | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/t/tests.t b/t/tests.t index eb2295c..ea79e36 100644 --- a/t/tests.t +++ b/t/tests.t @@ -1638,9 +1638,9 @@ for (@list) { 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); + 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); } } From a8840485de165e3345c23f975a11f896c3577615 Mon Sep 17 00:00:00 2001 From: Alex Vandiver Date: Wed, 19 Feb 2014 19:19:17 -0500 Subject: [PATCH 4/6] Use consistent indentation --- t/tests.t | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/t/tests.t b/t/tests.t index ea79e36..6b6eb41 100644 --- a/t/tests.t +++ b/t/tests.t @@ -1629,18 +1629,18 @@ 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]}; + $_->[0] =~ s/-- ATAT --/@/g; + my @addrs = Email::Address->parse($_->[0]); + my @tests = + map { Email::Address->new(map { $_ ? do {s/-- ATAT --/@/g; $_} : $_ } @$_) } + @{$_->[1]}; - 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); - } + 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); + } } From 68a6a40dbece74ffa32f7b840f70a9b9a055ea86 Mon Sep 17 00:00:00 2001 From: Alex Vandiver Date: Wed, 19 Feb 2014 19:25:20 -0500 Subject: [PATCH 5/6] Test to ensure that the expected number of addresses are returned Previously, extra addresses would not cause test failures --- t/tests.t | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/t/tests.t b/t/tests.t index 6b6eb41..6111fb7 100644 --- a/t/tests.t +++ b/t/tests.t @@ -1622,18 +1622,23 @@ my @list = ( ); my $tests = 1; -$tests += @{ $_->[1] } * 5 for @list; +$tests += 1 + @{ $_->[1] } * 5 for @list; plan tests => $tests; use_ok 'Email::Address'; for (@list) { - $_->[0] =~ s/-- ATAT --/@/g; - my @addrs = Email::Address->parse($_->[0]); + my ($string, $expect) = @$_; + + $string =~ s/-- ATAT --/@/g; + my @addrs = Email::Address->parse($string); + + is(@addrs, @$expect, "got correct number of results from parse {$string}"); + my @tests = - map { Email::Address->new(map { $_ ? do {s/-- ATAT --/@/g; $_} : $_ } @$_) } - @{$_->[1]}; + map { Email::Address->new(map { s/-- ATAT --/@/g if $_; $_ } @$_) } + @$expect; foreach (@addrs) { isa_ok($_, 'Email::Address'); From fe1a79f5827355772e44b82672d4b9855241736d Mon Sep 17 00:00:00 2001 From: Alex Vandiver Date: Mon, 29 Nov 2010 17:05:29 -0500 Subject: [PATCH 6/6] Allow domainless addresses, which only have a local part --- lib/Email/Address.pm | 55 +++++++++++++++++----- t/patterns.t | 5 +- t/tests.t | 108 ++++++++++++++++++++++++++++++++++++------- 3 files changed, 138 insertions(+), 30 deletions(-) diff --git a/lib/Email/Address.pm b/lib/Email/Address.pm index a7e9d1a..1954c78 100644 --- a/lib/Email/Address.pm +++ b/lib/Email/Address.pm @@ -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 } @@ -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 , "Casey" (West)] + ); + +This method returns a list of C objects it finds in the +input string; it differs from L 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); @@ -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 = $_; @@ -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; @@ -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'); @@ -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; } diff --git a/t/patterns.t b/t/patterns.t index db83ca5..fc2f9d1 100644 --- a/t/patterns.t +++ b/t/patterns.t @@ -42,6 +42,9 @@ my %tests = ( [ 'foo bar@bar.com', 0 ], [ '@bar.com', 0 ], ], + mailbox_domainless => [ + [ 'foo', 1 ], + ], ); my $num_tests = scalar( map @{$_}, values %tests ); @@ -54,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} }) { diff --git a/t/tests.t b/t/tests.t index 6111fb7..10af4ea 100644 --- a/t/tests.t +++ b/t/tests.t @@ -1618,34 +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 + @{ $_->[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) { - my ($string, $expect) = @$_; +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->parse($string); + $string =~ s/-- ATAT --/@/g; + my @addrs = Email::Address->$method($string); - is(@addrs, @$expect, "got correct number of results from parse {$string}"); + is(@addrs, @$expect, "got correct number of results from $method {$string}"); - my @tests = - map { Email::Address->new(map { s/-- ATAT --/@/g if $_; $_ } @$_) } - @$expect; + 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->as_string, "as_string: " . $test->as_string); - 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); + } } }