+sub _DecodeMIMEWordsToEncoding {
+ my $str = shift;
+ my $to_charset = shift;
+
+ # Pre-parse by removing all whitespace between encoded words
+ my $encoded_word = qr/
+ =\? # =?
+ ([^?]+?) # charset
+ (?:\*[^?]+)? # optional '*language'
+ \? # ?
+ ([QqBb]) # encoding
+ \? # ?
+ ([^?]+) # encoded string
+ \?= # ?=
+ /x;
+ $str =~ s/($encoded_word)\s+(?=$encoded_word)/$1/g;
+
+ # Also merge quoted-printable sections together, in case multiple
+ # octets of a single encoded character were split between chunks.
+ # Though not valid according to RFC 2047, this has been seen in the
+ # wild.
+ 1 while $str =~ s/(=\?[^?]+\?[Qq]\?)([^?]+)\?=\1([^?]+)\?=/$1$2$3?=/i;
+
+ # XXX TODO: use decode('MIME-Header', ...) and Encode::Alias to replace our
+ # custom MIME word decoding and charset canonicalization. We can't do this
+ # until we parse before decode, instead of the other way around.
+ my @list = $str =~ m/(.*?) # prefix
+ $encoded_word
+ ([^=]*) # trailing
+ /xgcs;
+ return $str unless @list;
+
+ # add everything that hasn't matched to the end of the latest
+ # string in array this happen when we have 'key="=?encoded?="; key="plain"'
+ $list[-1] .= substr($str, pos $str);
+
+ $str = '';
+ while (@list) {
+ my ($prefix, $charset, $encoding, $enc_str, $trailing) =
+ splice @list, 0, 5;
+ $charset = _CanonicalizeCharset($charset);
+ $encoding = lc $encoding;
+
+ if ( $encoding eq 'q' ) {
+ use MIME::QuotedPrint;
+ $enc_str =~ tr/_/ /; # RFC 2047, 4.2 (2)
+ $enc_str = decode_qp($enc_str);
+ } elsif ( $encoding eq 'b' ) {
+ use MIME::Base64;
+ $enc_str = decode_base64($enc_str);
+ } else {
+ $RT::Logger->warning("Incorrect encoding '$encoding' in '$str', "
+ ."only Q(uoted-printable) and B(ase64) are supported");
+ }
+
+ # now we have got a decoded subject, try to convert into the encoding
+ if ( $charset ne $to_charset || $charset =~ /^utf-?8(?:-strict)?$/i ) {
+ if ( Encode::find_encoding($charset) ) {
+ Encode::from_to( $enc_str, $charset, $to_charset );
+ } else {
+ $RT::Logger->warning("Charset '$charset' is not supported");
+ $enc_str =~ s/[^[:print:]]/\357\277\275/g;
+ Encode::from_to( $enc_str, 'UTF-8', $to_charset )
+ unless $to_charset eq 'utf-8';
+ }
+ }
+ $str .= $prefix . $enc_str . $trailing;
+ }
+
+ return ($str)
+}