implement: decode_base64_string(), decode_qp_string(), str_dump().

add a hack to modify the decoded string (decoded by IM) by replacing
\e$(B -> \e$B, it works well. But is it correct ?
XXX I cannot find \e$(B definition in RFC's.

1 files changed, 108 insertions, 2 deletions

diff --git a/fml/lib/Mail/Message/Encode.pm b/fml/lib/Mail/Message/Encode.pm
index ece2d4aa..735055d2 100644
--- a/fml/lib/Mail/Message/Encode.pm
+++ b/fml/lib/Mail/Message/Encode.pm
@@ -4,7 +4,7 @@
 #   All rights reserved. This program is free software; you can
 #   redistribute it and/or modify it under the same terms as Perl itself.
 #
-# $FML: Encode.pm,v 1.13 2003/07/21 14:34:31 fukachan Exp $
+# $FML: Encode.pm,v 1.14 2003/08/23 04:35:47 fukachan Exp $
 #
 
 package Mail::Message::Encode;
@@ -459,6 +459,20 @@ C<$options> is a HASH REFERENCE.
 You can specify the charset of the string to return
 by $options->{ charset }.
 
+[reference] RFC1554 says:
+
+      reg#  character set      ESC sequence                designated to
+      ------------------------------------------------------------------
+      6     ASCII              ESC 2/8 4/2      ESC ( B    G0
+      42    JIS X 0208-1978    ESC 2/4 4/0      ESC $ @    G0
+      87    JIS X 0208-1983    ESC 2/4 4/2      ESC $ B    G0
+      14    JIS X 0201-Roman   ESC 2/8 4/10     ESC ( J    G0
+      58    GB2312-1980        ESC 2/4 4/1      ESC $ A    G0
+      149   KSC5601-1987       ESC 2/4 2/8 4/3  ESC $ ( C  G0
+      159   JIS X 0212-1990    ESC 2/4 2/8 4/4  ESC $ ( D  G0
+      100   ISO8859-1          ESC 2/14 4/1     ESC . A    G2
+      126   ISO8859-7(Greek)   ESC 2/14 4/6     ESC . F    G2
+
 =cut
 
 
@@ -472,6 +486,8 @@ sub decode_mime_string
     my $lang    = $self->{ _language };
     my $str_out = '';
 
+    unless ($str) { return $str;}
+
     if ($lang eq 'japanese') {
 	eval q{
 	    use IM::EncDec;
@@ -479,12 +495,102 @@ sub decode_mime_string
 	};
 
 	return $str if $@;
+
+	# XXX IM returns "ESC$(B ... " string but
+	# XXX mule 2.3 cannot read "ESC$(B ... ESC(B" string as JIS.
+	# XXX ng detects it as ASCII.
+	# XXX Whereas, w3m looks to be able to read it ?
+	$str_out   =~ s/^\e\$\(B/\e\$B/; # make mule read this string.
+	$in_code   = $self->detect_code($str_out);
+	$out_code |= 'euc-jp'; # euc-jp by default.
     }
     else {
 	croak("Mail::Message::Encode: unknown language");
     }
 
-    return $self->convert($str_out, $out_code);
+    return $self->convert($str_out, $out_code, $in_code);
+}
+
+
+# Descriptions: decode MIME base64 encoded-string
+#    Arguments: OBJ($self) STR($str) STR($out_code) STR($in_code)
+# Side Effects: none
+# Return Value: STR
+sub decode_base64_string
+{
+    my ($self, $str, $out_code, $in_code) = @_;
+    my $lang    = $self->{ _language };
+    my $str_out = undef;
+
+    if ($lang eq 'japanese') {
+	eval q{
+	    use MIME::Base64;
+	    $str_out = decode_base64( $str );
+	};
+
+	return $str if $@;
+
+	$in_code   = $self->detect_code($str_out);
+	$out_code |= 'euc-jp'; # euc-jp by default.
+    }
+    else {
+	croak("Mail::Message::Encode: unknown language");
+    }
+
+    return $self->convert($str_out, $out_code, $in_code);
+}
+
+
+# Descriptions: decode MIME quoted-printable encoded-string
+#    Arguments: OBJ($self) STR($str) STR($out_code) STR($in_code)
+# Side Effects: none
+# Return Value: STR
+sub decode_qp_string
+{
+    my ($self, $str, $out_code, $in_code) = @_;
+    my $lang    = $self->{ _language };
+    my $str_out = undef;
+
+    if ($lang eq 'japanese') {
+	eval q{
+	    use MIME::QuotedPrint;
+	    $str_out = decode_qp( $str );
+	};
+	return $str if $@;
+
+	$in_code   = $self->detect_code($str_out);
+	$out_code |= 'euc-jp'; # euc-jp by default.
+    }
+    else {
+	croak("Mail::Message::Encode: unknown language");
+    }
+
+    return $self->convert($str_out, $out_code, $in_code);
+}
+
+
+=head1 DEBUG
+
+=head2 str_dump($str)
+
+=cut
+
+
+# Descriptions: dump $str as the style by "od -a"
+#    Arguments: OBJ($self) STR($str)
+# Side Effects: none
+# Return Value: none
+sub str_dump
+{
+    my ($self, $str) = @_;
+
+    $| = 1;
+    use FileHandle;
+    my $th = new FileHandle "|od -a";
+    if (defined $th) {
+	print $th $str;
+	$th->close();
+    }
 }