X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debbugs%2FMIME.pm;h=afc077649939784e4cedf95a81d7b75efb04ded8;hb=03115a2dbff942931b91ff106865a935de17db8e;hp=8c7b0cd5568305e5deaf2aabea903379fc1ce8c4;hpb=a2c4196704052c9fde1189801358c27116401d3d;p=debbugs.git diff --git a/Debbugs/MIME.pm b/Debbugs/MIME.pm index 8c7b0cd..afc0776 100644 --- a/Debbugs/MIME.pm +++ b/Debbugs/MIME.pm @@ -55,13 +55,10 @@ use POSIX qw(strftime); use List::MoreUtils qw(apply); # for convert_to_utf8 -use Debbugs::Common qw(convert_to_utf8); +use Debbugs::UTF8 qw(convert_to_utf8); -# for decode_rfc1522 -use MIME::WordDecoder qw(); +# for decode_rfc1522 and encode_rfc1522 use Encode qw(decode encode encode_utf8 decode_utf8 is_utf8); - -# for encode_rfc1522 use MIME::Words qw(); sub getmailbody @@ -118,6 +115,9 @@ sub parse my @msg = split /\n/, $_[0]; my $i; + # assume us-ascii unless charset is set; probably bad, but we + # really shouldn't get to this point anyway + my $charset = 'us-ascii'; for ($i = 0; $i <= $#msg; ++$i) { $_ = $msg[$i]; last unless length; @@ -125,10 +125,12 @@ sub parse ++$i; $_ .= "\n" . $msg[$i]; } + if (/charset=\"([^\"]+)\"/) { + $charset = $1; + } push @headerlines, $_; } - - @bodylines = @msg[$i .. $#msg]; + @bodylines = map {convert_to_utf8($_,$charset)} @msg[$i .. $#msg]; } rmtree $tempdir, 0, 1; @@ -202,8 +204,8 @@ sub create_mime_message{ # MIME::Entity is stupid, and doesn't rfc1522 encode its headers, so we do it for it. my $msg = MIME::Entity->build('Content-Type' => 'text/plain; charset=utf-8', 'Encoding' => 'quoted-printable', - (map{encode_rfc1522($_)} @{$headers}), - Data => is_utf8($body)?encode_utf8($body):$body, + (map{encode_rfc1522(encode_utf8($_))} @{$headers}), + Data => encode_utf8($body), ); # Attach the attachments @@ -248,24 +250,27 @@ Turn RFC-1522 names into the UTF-8 equivalent. =cut -BEGIN { - # Set up the default RFC1522 decoder, which turns all charsets that - # are supported into the appropriate UTF-8 charset. - MIME::WordDecoder->default(new MIME::WordDecoder( - ['*' => \&convert_to_utf8, - ])); -} - sub decode_rfc1522 { my ($string) = @_; # this is craptacular, but leading space is hacked off by unmime. # Save it. my $leading_space = ''; - $leading_space = $1 if $string =~ s/^(\s+)//; - # unmime calls the default MIME::WordDecoder handler set up at - # initialization time. - return $leading_space . MIME::WordDecoder::unmime($string); + $leading_space = $1 if $string =~ s/^(\ +)//; + # we must do this to switch off the utf8 flag before calling decode_mimewords + $string = encode_utf8($string); + my @mime_words = MIME::Words::decode_mimewords($string); + my $tmp = $leading_space . + join('', + (map { + if (@{$_} > 1) { + convert_to_utf8(${$_}[0],${$_}[1]); + } else { + decode_utf8(${$_}[0]); + } + } @mime_words) + ); + return $tmp; } =head2 encode_rfc1522 @@ -285,9 +290,10 @@ sub encode_rfc1522 { # handle being passed undef properly return undef if not defined $rawstr; - if (is_utf8($rawstr)) { - $rawstr= encode_utf8($rawstr); - } + + # convert to octets if we are given a string in perl's internal + # encoding + $rawstr= encode_utf8($rawstr) if is_utf8($rawstr); # We process words in reverse so we can preserve spacing between # encoded words. This regex splits on word|nonword boundaries and # nonword|nonword boundaries. We also consider parenthesis and "