Improve email address parsing

lib/Email/Address.pm

@@ -6,6 +6,7 @@ package Email::Address;
 our $COMMENT_NEST_LEVEL ||= 1;
 our $STRINGIFY          ||= 'format';
 our $COLLAPSE_SPACES      = 1 unless defined $COLLAPSE_SPACES; # I miss //=
+our $UNICODE            ||= 0;
 
 =head1 SYNOPSIS
 
@@ -172,9 +173,10 @@ collapse multiple spaces into a single space, which avoids this problem.  To
 prevent this behavior, set C<$Email::Address::COLLAPSE_SPACES> to zero.  This
 variable will go away when the bug is resolved properly.
 
-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.
+By default, this module mandates that email addresses be ASCII only, and any
+non-ASCII content will cause a blank result. This matches RFCs 822, 2822, and
+5322. If you wish to allow UTF-8 characters in email, as per RFCs 5335 and
+6532, set C<$Email:Address::UNICODE> to 1.
 
 =cut
 
@@ -223,8 +225,10 @@ sub parse {
           ($user, $host) = ($1, $2);
       }
 
-      next if $user =~ /\P{ASCII}/;
-      next if $host =~ /\P{ASCII}/;
+      unless ($UNICODE) {
+          next if $user =~ /\P{ASCII}/;
+          next if $host =~ /\P{ASCII}/;
+      }
 
       my ($phrase)       = /($display_name)/o;
 

t/ascii.t

@@ -10,50 +10,63 @@ my $ascii = q{admin@mozilla.org};
 my $utf_8 = q{аdmin@mozilla.org};
 my $text  = decode('utf-8', $utf_8, Encode::LEAVE_SRC);
 
-my $ok_mixed  = qq{"$text" <$ascii>};
-my $bad_mixed = qq{"$text" <$text>};
+my $ascii_mixed = qq{"$text" <$ascii>};
+my $utf8_mixed = qq{"$text" <$text>};
 
-{
-  my (@addr) = Email::Address->parse($ascii);
-  is(@addr, 1, "an ascii address is a-ok");
+for (0..1) {
+  local $Email::Address::UNICODE = $_;
 
-  # ok( $ascii =~ $Email::Address::addr_spec, "...it =~ addr_spec");
-}
+  {
+    my (@addr) = Email::Address->parse($ascii);
+    is(@addr, 1, "an ascii address is a-ok");
 
-{
-  my (@addr) = Email::Address->parse($ok_mixed);
-  is(@addr, 1, "a quoted non-ascii phrase is a-ok with ascii email");
-}
+    # ok( $ascii =~ $Email::Address::addr_spec, "...it =~ addr_spec");
+  }
 
-{
-  my (@addr) = Email::Address->parse($bad_mixed);
-  is(@addr, 0, "a quoted non-ascii phrase is not okay with non-ascii email");
-}
+  {
+    my (@addr) = Email::Address->parse($ascii_mixed);
+    is(@addr, 1, "a quoted non-ascii phrase is a-ok with ascii email");
+  }
 
-{
-  my (@addr) = Email::Address->parse($utf_8);
-  is(@addr, 0, "utf-8 octet address: not ok");
+  {
+    my (@addr) = Email::Address->parse($utf8_mixed);
+    is(@addr, $Email::Address::UNICODE, "a quoted non-ascii phrase with non-ascii email");
+  }
 
-  # ok( $utf_8 !~ $Email::Address::addr_spec, "...it !~ addr_spec");
-}
+  {
+    my (@addr) = Email::Address->parse($utf_8);
+    is(@addr, $Email::Address::UNICODE, "utf-8 octet address");
 
-{
-  my (@addr) = Email::Address->parse($text);
-  is(@addr, 0, "unicode (decoded) address: not ok");
+    # ok( $utf_8 !~ $Email::Address::addr_spec, "...it !~ addr_spec");
+  }
 
-  # ok( $text =~ $Email::Address::addr_spec, "...it !~ addr_spec");
-}
+  {
+    my (@addr) = Email::Address->parse($text);
+    is(@addr, $Email::Address::UNICODE, "unicode (decoded) address");
+
+    # ok( $text =~ $Email::Address::addr_spec, "...it !~ addr_spec");
+  }
+
+  {
+    my @addr = Email::Address->parse(qq{
+      "Not ascii phras\x{e9}" <good\@email>,
+      b\x{e3}d\@user,
+      bad\@d\x{f6}main,
+      not.bad\@again
+    });
+    is scalar @addr, $Email::Address::UNICODE ? 4 : 2, "correct number of good emails";
+    is "$addr[0]", qq{"Not ascii phras\x{e9}" <good\@email>}, "expected email";
+    if ($Email::Address::UNICODE) {
+      is "$addr[1]", qq{b\x{e3}d\@user}, "expected email";
+      is "$addr[2]", qq{bad\@d\x{f6}main}, "expected email";
+      is "$addr[3]", qq{not.bad\@again}, "expected email";
+    } else {
+      is "$addr[1]", qq{not.bad\@again}, "expected email";
+    }
+  }
+
+  Email::Address->purge_cache;
 
-{
-  my @addr = Email::Address->parse(qq{
-    "Not ascii phras\x{e9}" <good\@email>,
-    b\x{e3}d\@user,
-    bad\@d\x{f6}main,
-    not.bad\@again
-  });
-  is scalar @addr, 2, "correct number of good emails";
-  is "$addr[0]", qq{"Not ascii phras\x{e9}" <good\@email>}, "expected email";
-  is "$addr[1]", qq{not.bad\@again}, "expected email";
 }
 
 done_testing;