diff --git a/Build.PL b/Build.PL index 5218241..451a26c 100644 --- 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 index dc8ce23..69684f8 100644 --- 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 index 094e60d..45108f3 100644 --- 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 }) {