obsolete Mail::Message::Encode functions are moved to here temporarily.feature/utf8-mime-header-handling

The functions are
encode_mime_string(), decode_mime_string() and decode_mime_utf8_to_euc().

1 files changed, 194 insertions, 0 deletions

diff --git a/fml/lib/Mail/Message/Encode/Obsolete.pm b/fml/lib/Mail/Message/Encode/Obsolete.pm
new file mode 100644
index 00000000..68bedbc8
--- /dev/null
+++ b/fml/lib/Mail/Message/Encode/Obsolete.pm
@@ -0,0 +1,194 @@
+#-*- perl -*-
+#
+#  Copyright (C) 2018 Ken'ichi Fukamachi
+#   All rights reserved. This program is free software; you can
+#   redistribute it and/or modify it under the same terms as Perl itself.
+#
+# $FML$
+#
+
+package Mail::Message::Encode::Obsolete;
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD);
+use Carp;
+
+=head1 NAME
+
+Mail::Message::Encode::Obsolete - obsolete encode/decode routines.
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+Temporarily obsolete functions in Mail::Message::Encode are moved to here.
+
+=head1 MIME ENCODE/DECODE
+
+=head2 encode_mime_string($str, $encode, $out_code, $in_code)
+
+encode string $str to encoding system $encode with output code $out_code.
+$in_code is used as a hint.
+
+=cut
+
+
+# Descriptions: encode string.
+#    Arguments: OBJ($self) STR($str) STR($encode) STR($out_code) STR($in_code)
+# Side Effects: croak() if language is unknown.
+# Return Value: STR
+sub encode_mime_string
+{
+    my ($self, $str, $encode, $out_code, $in_code) = @_;
+    my $lang     = $self->{ _language };
+    my $str_orig = $str;
+    my $str_out  = '';
+
+    # base64 encoding by default.
+    $encode ||= 'base64';
+
+    # code by default
+    if ($lang eq 'japanese') {
+	$out_code ||= 'jis';
+	$str = $self->convert($str, $out_code, $in_code);
+    }
+    else {
+	croak("Mail::Message::Encode: unknown language");
+    }
+
+    if ($encode eq 'base64') {
+	eval q{
+	    use IM::Iso2022jp;
+	    $str_out = line_iso2022jp_mimefy($str);
+	};
+    }
+    elsif ($encode eq 'qp') {
+	eval q{
+	    use IM::Iso2022jp;
+	    $main::HdrQEncoding = 1;
+	    $str_out = line_iso2022jp_mimefy($str);
+	    $main::HdrQEncoding = 0;
+	};
+    }
+    else {
+	croak("Mail::Message::Encode: unknown encoding");
+    }
+
+    return $str_out ? $str_out : $str_orig;
+}
+
+
+=head2 decode_mime_string(string, [$options])
+
+decode a base64/quoted-printable encoded string to a plain message.
+The encoding method is automatically detected.
+
+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
+
+# Descriptions: decode MIME string.
+#    Arguments: OBJ($self) STR($str) STR($out_code) STR($in_code)
+# Side Effects: croak() if language is unknown.
+# Return Value: STR
+sub decode_mime_string
+{
+    my ($self, $str, $out_code, $in_code) = @_;
+    my $lang    = $self->{ _language };
+    my $str_out = '';
+
+    unless ($str) { return $str;}
+
+    if ($lang eq 'japanese') {
+	if ($str =~ /=\?utf-8\?[bq]\?/i)  {
+	    $str_out = $self->decode_mime_utf8_to_euc($str);
+	}
+	else {
+	    eval q{
+		use IM::EncDec;
+		$str_out = mime_decode_string( $str );
+	    };
+
+	    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.
+
+	# XXX-TODO: use Mail::Message::Charset ?
+	$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 encoded string for utf8.
+#    Arguments: OBJ($self) STR($str)
+# Side Effects: none
+# Return Value: STR
+sub decode_mime_utf8_to_euc
+{
+    my ($self, $str) = @_;
+
+    if ($str =~ /=\?utf-8\?(\w)\?/i) {
+	if ($1 =~ /B/i) {
+	    $str =~ s/=\?utf-8\?B\?([A-Za-z0-9+\/]+=*)\?=/$1/gi;
+	    $str = $self->raw_decode_base64($str);
+	}
+	elsif ($1 =~ /Q/i)  {
+	    $str =~ s/=\?utf-8\?q\?([\x20-\x7e\t]+?)\?=/$1/gi;
+	    $str = $self->raw_decode_qp($str);
+	}
+    }
+
+    $str =~ s/\n//g;
+    use Jcode;
+    return Jcode->new($str,"utf8")->euc;
+}
+
+
+=head1 CODING STYLE
+
+See C<http://www.fml.org/software/FNF/> on fml coding style guide.
+
+=head1 AUTHOR
+
+Ken'ichi Fukamachi
+
+=head1 COPYRIGHT
+
+Copyright (C) 2018 Ken'ichi Fukamachi
+
+All rights reserved. This program is free software; you can
+redistribute it and/or modify it under the same terms as Perl itself.
+
+=head1 HISTORY
+
+Mail::Message::Encode first appeared in fml8 mailing list driver package.
+See C<http://www.fml.org/> for more details.
+
+=cut
+
+1;