Use Email::Address to encode address headers.

This is a more correct fix for #6, as discussed in #11.
theory · Mar 29, 2016 · ce3a506 · ce3a506
1 parent 6c83099
commit ce3a506
Show file tree

Hide file tree

Showing 3 changed files with 32 additions and 7 deletions.
diff --git a/Build.PL b/Build.PL
@@ -40,9 +40,10 @@ my $build = $class->new(
         'perl'         => 5.006,
     },
     build_requires     => {
-        'Test::More'    => '0.17',
-        'Module::Build' => '0.2701',
-        'File::Spec'    => 0,
+        'Test::More'     => '0.17',
+        'Module::Build'  => '0.2701',
+        'File::Spec'     => 0,
+        'Email::Address' => '1.897',
     },
     recommends => {
         'Pod::Usage'          => '1.33',

diff --git a/Changes b/Changes
@@ -6,6 +6,11 @@ Revision history for Perl extension SVN::Notify
         Perl 5.21.
       - Fixed test failures triggered by an improvement to the encoding of
         headers by the Encode module. Thanks to Pali for the fix!
+      - Improved the encoding of the "From", "To", and "Reply-To" headers so
+        that only the phrase part is encoded, not the address itself. Thanks
+        to Pali for the corrections.
+      - Now require Email::Address to handle the proper parsing of addresses
+        for encoding into headers.
 
 2.84  2013-08-13T14:25:21Z
       - Added `--smtp-tls` to the output of `man svnnotify`.

diff --git a/lib/SVN/Notify.pm b/lib/SVN/Notify.pm
@@ -1462,9 +1462,27 @@ sub output_headers {
     $self->_dbpnt( "Outputting headers") if $self->{verbose} > 2;
 
     # Q-Encoding (RFC 2047)
-    my $subj = ( PERL58 && $self->{subject} =~ /(?:\P{ASCII}|=)/s ) ? Encode::encode( 'MIME-Q', $self->{subject} ) : $self->{subject};
-    my $from = $self->{from};
-    my $to = join ', ', @{ $self->{to} };
+    my $subj = PERL58 && $self->{subject} =~ /(?:\P{ASCII}|=)/s
+        ? Encode::encode( 'MIME-Q', $self->{subject} )
+        : $self->{subject};
+
+    # Q-Encode the phrase part of recipient headers.
+    require Email::Address;
+    my $norm = sub {
+        return join ', ' => map {
+            my ($addr) = Email::Address->parse($_);
+            if ($addr) {
+                if (my $phrase = $addr->phrase) {
+                    $addr->phrase(Encode::encode( 'MIME-Q', $phrase ));
+                }
+                $addr->format;
+            } else {
+                $_;
+            }
+        } @_;
+    };
+    my $from = $norm->($self->{from});
+    my $to = $norm->(@{ $self->{to} });
 
     my @headers = (
         "MIME-Version: 1.0\n",
@@ -1476,7 +1494,8 @@ sub output_headers {
         "Subject: $subj\n"
     );
 
-    push @headers, "Reply-To: $self->{reply_to}\n" if $self->{reply_to};
+    push @headers, 'Reply-To: ' . $norm->($self->{reply_to}) . "\n"
+        if $self->{reply_to};
 
     if (my $heads = $self->{add_headers}) {
         while (my ($k, $v) = each %{ $heads }) {