From d21f70902f473287eb9ed49bb1a5b112ab0bd5ad Mon Sep 17 00:00:00 2001
From: Ruslan Zakirov <ruz@bestpractical.com>
Date: Tue, 6 Nov 2012 12:20:20 +0400
Subject: [PATCH 1/2] properly escape chars when quoting phrase

Not only " should be escaped, but \ as well.
---
 lib/Email/Address.pm | 2 +-
 t/quoting.t          | 8 +++++++-
 2 files changed, 8 insertions(+), 2 deletions(-)

diff --git a/lib/Email/Address.pm b/lib/Email/Address.pm
index 6dae9f8..f7f1860 100644
--- a/lib/Email/Address.pm
+++ b/lib/Email/Address.pm
@@ -441,7 +441,7 @@ sub _enquoted_phrase {
   return $phrase if $phrase =~ /\A=\?.+\?=\z/;
 
   $phrase =~ s/\A"(.+)"\z/$1/;
-  $phrase =~ s/\"/\\"/g;
+  $phrase =~ s/([\\"])/\\$1/g;
 
   return qq{"$phrase"};
 }
diff --git a/t/quoting.t b/t/quoting.t
index 1d1b6fb..604a2af 100644
--- a/t/quoting.t
+++ b/t/quoting.t
@@ -2,7 +2,7 @@
 use strict;
 
 use Email::Address;
-use Test::More tests => 6;
+use Test::More tests => 8;
 
 my $phrase = q{jack!work};
 my $email  = 'jack@work.com';
@@ -36,3 +36,9 @@ is(
 );
 
 is($ea3->phrase, $phrase, "the phrase method returns the right thing");
+
+{
+    my $ea = Email::Address->new(q{jack "\\" robinson}, 'jack@work.com');
+    is $ea->phrase, q{jack "\\" robinson};
+    is $ea->format, q{"jack \\"\\\\\\" robinson" <jack@work.com>};
+}

From 89fddb4802fe9e660ba41891e75a3e6c2f15d473 Mon Sep 17 00:00:00 2001
From: Ruslan Zakirov <ruz@bestpractical.com>
Date: Tue, 6 Nov 2012 14:08:46 +0400
Subject: [PATCH 2/2] parse in one go using capturing regexp

Before this change each matched mailbox in the string
was re-matched with separate regexps to extract parts.
This could lead to very suprising results. See ticket #52102
for details [1].

Also, quoted phrases was not de-quoted properly.

[1] https://rt.cpan.org/Ticket/Display.html?id=52102
---
 lib/Email/Address.pm | 39 ++++++++++++++++++++-------------------
 t/quoting.t          |  3 ++-
 t/tests.t            | 32 +++++++++++++++++++++++++++++++-
 3 files changed, 53 insertions(+), 21 deletions(-)

diff --git a/lib/Email/Address.pm b/lib/Email/Address.pm
index f7f1860..b8ca9fb 100644
--- a/lib/Email/Address.pm
+++ b/lib/Email/Address.pm
@@ -144,6 +144,12 @@ $angle_addr = qr/$cfws*<$addr_spec>$cfws*/;
 $name_addr  = qr/$display_name?$angle_addr/;
 $mailbox    = qr/(?:$name_addr|$addr_spec)$comment*/;
 
+my $capturing_mailbox = qr/
+    (?:($display_name)?($cfws*)<($addr_spec)>($cfws*)
+        |($addr_spec)
+    )($comment*)
+/x;
+
 sub _PHRASE   () { 0 }
 sub _ADDRESS  () { 1 }
 sub _COMMENT  () { 2 }
@@ -213,36 +219,31 @@ sub parse {
         return @cached;
     }
 
-    my (@mailboxes) = ($line =~ /$mailbox/go);
+    my (@mailboxes) = ($line =~ /($capturing_mailbox)/go);
     my @addrs;
-    foreach (@mailboxes) {
-      my $original = $_;
-
-      my @comments = /($comment)/go;
-      s/$comment//go if @comments;
+    while (my @list = splice @mailboxes, 0, 7) {
+      my ($original, $phrase, $address, @comments)
+        = ($list[0], $list[1], $list[3]||$list[5], @list[2,4,6]);
 
-      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);
-      }
+      return if $address =~ /\P{ASCII}/;
 
-      return if $user =~ /\P{ASCII}/;
-      return if $host =~ /\P{ASCII}/;
+      if ( defined $phrase ) {
+        # for backwards compatibility
+        unshift @comments, $phrase =~ /($comment)/go;
+        $phrase =~ s/$comment//go;
 
-      my ($phrase)       = /($display_name)/o;
+        $phrase =~ s/\\(.)/$1/g if $phrase =~ s/\A\s*"(.*)"\s*\z/$1/;
+      }
 
-      for ( $phrase, $host, $user, @comments ) {
+      for ( $phrase, $address, @comments ) {
         next unless defined $_;
         s/^\s+//;
         s/\s+$//;
         $_ = undef unless length $_;
       }
 
-      my $new_comment = join q{ }, @comments;
-      push @addrs,
-        $class->new($phrase, "$user\@$host", $new_comment, $original);
+      my $new_comment = join q{ }, grep defined, @comments;
+      push @addrs, $class->new($phrase, $address, $new_comment, $original);
       $addrs[-1]->[_IN_CACHE] = [ \$line, $#addrs ]
     }
 
diff --git a/t/quoting.t b/t/quoting.t
index 604a2af..e824f1c 100644
--- a/t/quoting.t
+++ b/t/quoting.t
@@ -38,7 +38,8 @@ is(
 is($ea3->phrase, $phrase, "the phrase method returns the right thing");
 
 {
-    my $ea = Email::Address->new(q{jack "\\" robinson}, 'jack@work.com');
+    my $mailbox = q{"jack \\"\\\\\\" robinson" <jack@work.com>};
+    my ($ea) = Email::Address->parse($mailbox);
     is $ea->phrase, q{jack "\\" robinson};
     is $ea->format, q{"jack \\"\\\\\\" robinson" <jack@work.com>};
 }
diff --git a/t/tests.t b/t/tests.t
index 12e4ba2..800a9d6 100644
--- a/t/tests.t
+++ b/t/tests.t
@@ -1618,7 +1618,37 @@ my @list = (
         undef,
       ],
     ],
-  ]
+  ],
+  [
+    '"Newsletter from <superm-- ATAT --rket>" <newsletter-- ATAT --example.com>',
+    [
+      [
+        "Newsletter from <superm-- ATAT --rket>",
+        'newsletter-- ATAT --example.com',
+        undef,
+      ],
+    ],
+  ],
+  [
+    '"Lawrence \\"Yogi\\" Berra" <yogi-- ATAT --example.com>',
+    [
+      [
+        'Lawrence "Yogi" Berra',
+        'yogi-- ATAT --example.com',
+        undef,
+      ],
+    ],
+  ],
+  [
+    '"Peter \Sales Department" <peter-- ATAT --example.com>',
+    [
+      [
+        "Peter Sales Department",
+        'peter-- ATAT --example.com',
+        undef,
+      ],
+    ],
+  ],
 );
 
 my $tests = 1;