diff options
| -rw-r--r-- | fml/lib/Mail/Message/Encode.pm | 147 |
1 files changed, 2 insertions, 145 deletions
diff --git a/fml/lib/Mail/Message/Encode.pm b/fml/lib/Mail/Message/Encode.pm index 5f17af32..346ae3b6 100644 --- a/fml/lib/Mail/Message/Encode.pm +++ b/fml/lib/Mail/Message/Encode.pm @@ -19,9 +19,7 @@ Mail::Message::Encode - encode/decode/charset conversion routines. =head1 SYNOPSIS use Mail::Message::Encode; - my $obj = new Mail::Message::Encode; - $str = $obj->encode_mime_string($str, $encode, $out_code, $in_code); - $self->set($str); + my $code = Mail::Message::Encode->detect_code($str); It is not recommended but if you use old style, import required function: @@ -373,127 +371,10 @@ sub STR2JIS } -=head1 MIME ENCODE - -=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 +=head1 MIME ENCODE/DECODE =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 base64 encoded-string. # Arguments: OBJ($self) STR($str) STR($out_code) STR($in_code) @@ -589,30 +470,6 @@ sub raw_decode_qp return( $rbuf || $buf ); } -# 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 |