summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Encode/MIME/Header.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Encode/MIME/Header.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/Encode/MIME/Header.pm27
1 files changed, 13 insertions, 14 deletions
diff --git a/Master/tlpkg/tlperl/lib/Encode/MIME/Header.pm b/Master/tlpkg/tlperl/lib/Encode/MIME/Header.pm
index b970b62577d..ba6adba4758 100644
--- a/Master/tlpkg/tlperl/lib/Encode/MIME/Header.pm
+++ b/Master/tlpkg/tlperl/lib/Encode/MIME/Header.pm
@@ -3,7 +3,7 @@ use strict;
use warnings;
no warnings 'redefine';
-our $VERSION = do { my @r = ( q$Revision: 2.16 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r };
+our $VERSION = do { my @r = ( q$Revision: 2.19 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r };
use Encode qw(find_encoding encode_utf8 decode_utf8);
use MIME::Base64;
use Carp;
@@ -39,15 +39,14 @@ sub perlio_ok { 0 }
sub decode($$;$) {
use utf8;
my ( $obj, $str, $chk ) = @_;
-
# zap spaces between encoded words
$str =~ s/\?=\s+=\?/\?==\?/gos;
-
+
# multi-line header to single line
$str =~ s/(?:\r\n|[\r\n])[ \t]//gos;
1 while ( $str =~
- s/(=\?[-0-9A-Za-z_]+\?[Qq]\?)(.*?)\?=\1(.*?\?=)/$1$2$3/ )
+ s/(=\?[-0-9A-Za-z_]+\?[Qq]\?)([^?]*?)\?=\1([^?]*?\?=)/$1$2$3/ )
; # Concat consecutive QP encoded mime headers
# Fixes breaking inside multi-byte characters
@@ -108,20 +107,20 @@ my $re_encoded_word = qr{
my $re_especials = qr{$re_encoded_word|$especials}xo;
+# cf:
+# https://rt.cpan.org/Ticket/Display.html?id=88717
+# https://www.ietf.org/rfc/rfc0822.txt
+my $re_linear_white_space = qr{(?:[ \t]|\r\n?)};
+
sub encode($$;$) {
my ( $obj, $str, $chk ) = @_;
my @line = ();
for my $line ( split /\r\n|[\r\n]/o, $str ) {
my ( @word, @subline );
- for my $word ( split /($re_especials)/o, $line ) {
- if ( $word =~ /[^\x00-\x7f]/o
- or $word =~ /^$re_encoded_word$/o )
- {
- push @word, $obj->_encode($word);
- }
- else {
- push @word, $word;
- }
+ if ($line =~ /\A([\w\-]+:\s+)(.*)\z/o) {
+ push @word, $1, $obj->_encode($2); # "X-Header-Name: ..."
+ } else {
+ push @word, $obj->_encode($line); # anything else
}
my $subline = '';
for my $word (@word) {
@@ -136,7 +135,7 @@ sub encode($$;$) {
$subline .= $word;
}
length($subline) and push @subline, $subline;
- push @line, join( "\n " => @subline );
+ push @line, join( "\n " => grep !/^$/, @subline );
}
$_[1] = '' if $chk;
return (substr($str, 0, 0) . join( "\n", @line ));