package Encode
::MIME
::Header
::ISO_2022_JP
;
use base
qw(Encode::MIME::Header);
$Encode::Encoding
{'MIME-Header-ISO_2022_JP'}
= bless {encode
=> 'B', bpl
=> 76, Name
=> 'MIME-Header-ISO_2022_JP'}
use constant HEAD
=> '=?ISO-2022-JP?B?';
use constant TAIL
=> '?=';
use Encode
::CJKConstants
qw(%RE);
our $VERSION = do { my @r = (q$Revision: 1.1 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
# I owe the below codes totally to
# Jcode by Dan Kogai & http://www.din.or.jp/~ohzaki/perl.htm#JP_Base64
utf8::encode($str) if( Encode::is_utf8($str) );
Encode::from_to($str, 'utf8', 'euc-jp');
my($trailing_crlf) = ($str =~ /(\n|\r|\x0d\x0a)$/o);
$str = _mime_unstructured_header($str, $self->{bpl});
not $trailing_crlf and $str =~ s/(\n|\r|\x0d\x0a)$//o;
sub _mime_unstructured_header {
my ($oldheader, $bpl) = @_;
my $crlf = $oldheader =~ /\n$/;
my($header, @words, @wordstmp, $i) = ('');
@wordstmp = split /\s+/, $oldheader;
for ($i = 0; $i < $#wordstmp; $i++){
if( $wordstmp[$i] !~ /^[\x21-\x7E]+$/ and $wordstmp[$i + 1] !~ /^[\x21-\x7E]+$/){
$wordstmp[$i + 1] = "$wordstmp[$i] $wordstmp[$i + 1]";
push(@words, $wordstmp[$i]);
push(@words, $wordstmp[-1]);
if ($word =~ /^[\x21-\x7E]+$/) {
$header =~ /(?:.*\n)*(.*)/;
if (length($1) + length($word) > $bpl) {
$header = _add_encoded_word($word, $header, $bpl);
$header =~ /(?:.*\n)*(.*)/;
$crlf ? "$header\n" : $header;
my($str, $line, $bpl) = @_;
if(length($line) + 22 + ($target =~ /^(?:$RE{EUC_0212}|$RE{EUC_C})/o) * 8 > $bpl){
$line =~ s/[ \t\n\r]*$/\n/;
my $iso_2022_jp = $target;
Encode::from_to($iso_2022_jp, 'euc-jp', 'iso-2022-jp');
= HEAD . MIME::Base64::encode_base64($iso_2022_jp, '') . TAIL;
if(length($encoded) + length($line) > $bpl){
$target =~ s/($RE{EUC_0212}|$RE{EUC_KANA}|$RE{EUC_C}|$RE{ASCII})$//o;