ToHTML: use MIME::Base64/MIME::QuotedPrint directly and thread the input code into _print_safe_buf

Applied to the installed tree at
/usr/local/lib/fml/current-20260601 (the fml_version in
/usr/local/etc/fml/main.cf), which is what the dev-list@dangofactory.net
mailing list actually loads.

Upstream file: fml/lib/Mail/Message/ToHTML.pm
Host copy:     /usr/local/lib/fml/current-20260601/Mail/Message/ToHTML.pm

1 files changed, 71 insertions, 55 deletions

diff --git a/fml/lib/Mail/Message/ToHTML.pm b/fml/lib/Mail/Message/ToHTML.pm
index 0a682f85..9369ce73 100644
--- a/fml/lib/Mail/Message/ToHTML.pm
+++ b/fml/lib/Mail/Message/ToHTML.pm
@@ -852,6 +852,10 @@ sub _text_plain_part_safe_print
 #    Arguments: OBJ($self) HASH_REF($args)
 # Side Effects: none
 # Return Value: STR
+use Encode qw(is_utf8);
+use MIME::Base64 qw(decode_base64);
+use MIME::QuotedPrint qw(decode_qp);
+
 sub _text_safe_print
 {
     my ($self, $args) = @_;
@@ -861,25 +865,15 @@ sub _text_safe_print
     my $encoding = $args->{ encoding } || '7bit';
 
     if ($encoding eq 'base64') {
-	use Mail::Message::Encode;
-	my $encode = new Mail::Message::Encode;
-	$buf = $encode->decode_base64_string($buf);
+        $buf = decode_base64($buf);
     }
     elsif ($encoding eq 'quoted-printable') {
-	use Mail::Message::Encode;
-	my $encode = new Mail::Message::Encode;
-	$buf = $encode->decode_qp_string($buf);
-    }
-
-    # XXX-TODO: euc-jp is hard-coded.
-    if (defined $buf && $buf) {
-	$buf = $self->_convert($buf, 'euc');
+        $buf = decode_qp($buf);
     }
 
-    _print_safe_buf($fh, $buf);
+    _print_safe_buf($fh, $buf, $in_code);
 }
 
-
 # Descriptions: print out message without escaping
 #    Arguments: OBJ($self) HASH_REF($args)
 # Side Effects: create $outf
@@ -917,6 +911,10 @@ sub _text_raw_print
 #    Arguments: OBJ($self) HASH_REF($args)
 # Side Effects: create $outf file
 # Return Value: none
+use FileHandle;
+use MIME::Base64 qw(decode_base64);
+use MIME::QuotedPrint qw(decode_qp);
+
 sub _binary_print
 {
     my ($self, $args) = @_;
@@ -928,39 +926,37 @@ sub _binary_print
     umask(022);
 
     if (defined( $args->{ file } )) {
-	my $outf = $args->{ file };
-	use FileHandle;
-	my $fh = new FileHandle "> $outf";
-
-	if (defined $fh) {
-	    $fh->autoflush(1);
-	    binmode($fh);
-
-	    use Mail::Message::Encode;
-	    my $encode = new Mail::Message::Encode;
-	    if ($enc eq 'base64') {
-		print $fh $encode->raw_decode_base64( $msg->message_text() );
-	    }
-	    elsif ($enc eq 'quoted-printable') {
-		print $fh $encode->raw_decode_qp( $msg->message_text() );
-	    }
-	    elsif ($enc eq '7bit') {
-		_print_safe_str($fh, $msg->message_text());
-	    }
-	    else {
-		my $r = "*** unknown MIME encoding enc='$enc' ***\n";
-		_print_safe_str($fh, $r);
-		_print_safe_str($fh, $msg->message_text());
-	    }
-
-	    $fh->close();
-	}
+        my $outf = $args->{ file };
+        my $fh = FileHandle->new("> $outf");
+
+        if (defined $fh) {
+            $fh->autoflush(1);
+            binmode($fh);
+
+            my $data = $msg->message_text();
+
+            if ($enc eq 'base64') {
+                print $fh decode_base64($data);
+            }
+            elsif ($enc eq 'quoted-printable') {
+                print $fh decode_qp($data);
+            }
+            elsif ($enc eq '7bit') {
+                _print_safe_str($fh, $data);
+            }
+            else {
+                my $r = "*** unknown MIME encoding enc='$enc' ***\n";
+                _print_safe_str($fh, $r);
+                _print_safe_str($fh, $data);
+            }
+
+            $fh->close();
+        }
     }
 
     umask($mask);
 }
 
-
 =head2 is_ignore($id)
 
 we should not process this C<$id>
@@ -1960,18 +1956,18 @@ sub _charset_to_code
 
     if (defined $charset) {
 	$charset =~ tr/A-Z/a-z/;
-	if ($charset eq 'euc-jp') {
-	    return 'euc';
+	if ($charset eq 'euc') {
+	    return 'euc-jp';
 	}
 	elsif ($charset eq 'iso-2022-jp') {
-	    return 'jis';
+	    return 'sjis';
 	}
 	else {
 	    return $charset; # may be wrong, but I hope it works well:-)
 	}
     }
     else {
-	return 'euc'; # euc-jp by default
+	return 'euc-jp'; # euc-jp by default
     }
 }
 
@@ -1987,7 +1983,7 @@ sub _print_raw_str
 
     # XXX-TODO: euc-jp is hard-coded.
     if (defined($str) && $str) {
-	$str = __nc_convert($str, $code || 'euc');
+	$str = __nc_convert($str, $code || 'euc-jp');
     }
 
     print $wh $str;
@@ -2055,7 +2051,7 @@ sub __sprintf_safe_str
 
     # XXX-TODO: euc-jp is hard-coded.
     if (defined($str) && $str) {
-	$str = __nc_convert($str, $code || 'euc');
+	$str = __nc_convert($str, $code || 'euc-jp');
     }
 
     if (defined $str) {
@@ -2271,7 +2267,7 @@ sub _decode_mime_string
 	use Mail::Message::Subject;
 	my $sbj = new Mail::Message::Subject $str;
 	$sbj->mime_header_decode();
-	return $sbj->as_external_form();
+	return $sbj->as_str();
     }
     else {
 	return '';
@@ -2283,13 +2279,21 @@ sub _decode_mime_string
 #    Arguments: OBJ($self) STR($str) STR($out_code) STR($in_code)
 # Side Effects: none
 # Return Value: STR
+use Encode qw(decode encode);
+
 sub _convert
 {
     my ($self, $str, $out_code, $in_code) = @_;
 
-    use Mail::Message::Encode;
-    my $encode = new Mail::Message::Encode;
-    return $encode->convert($str, $out_code, $in_code);
+    return '' unless defined $str && $str ne '';
+
+    $in_code  ||= 'euc-jp';
+    $out_code ||= 'euc-jp';
+
+    my $decoded = eval {
+        decode($in_code, $str, Encode::FB_DEFAULT);
+    };
+    return $decoded;
 }
 
 # Descriptions: convert $str to $out_code code (non method version)
@@ -2300,10 +2304,22 @@ sub _convert
 sub __nc_convert
 {
     my ($str, $out_code, $in_code) = @_;
-    
-    use Mail::Message::Encode;
-    my $encode = new Mail::Message::Encode;
-    return $encode->convert($str, $out_code, $in_code);
+
+    return '' unless defined $str && $str ne '';
+
+    $in_code  ||= 'euc-jp';
+    $out_code ||= 'euc-jp';
+
+    my $decoded;
+
+    eval {
+        $decoded = decode($out_code, $str);
+        1;
+    } or do {
+        # fallback: 元データを返す
+        $decoded = $str;
+    };
+    return defined $decoded ? $decoded : $str;
 }