1package Encode::MIME::Header::ISO_2022_JP;
2
3use strict;
4use base qw(Encode::MIME::Header);
5
6$Encode::Encoding{'MIME-Header-ISO_2022_JP'}
7  = bless {encode => 'B', bpl => 76, Name => 'MIME-Header-ISO_2022_JP'}
8   => __PACKAGE__;
9
10use constant HEAD   => '=?ISO-2022-JP?B?';
11use constant TAIL   => '?=';
12
13use Encode::CJKConstants qw(%RE);
14
15our $VERSION = do { my @r = (q$Revision: 1.2 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
16
17
18# I owe the below codes totally to
19#   Jcode by Dan Kogai & http://www.din.or.jp/~ohzaki/perl.htm#JP_Base64
20
21sub encode {
22	my $self = shift;
23	my $str  = shift;
24
25	utf8::encode($str) if( Encode::is_utf8($str) );
26	Encode::from_to($str, 'utf8', 'euc-jp');
27
28	my($trailing_crlf) = ($str =~ /(\n|\r|\x0d\x0a)$/o);
29
30	$str = _mime_unstructured_header($str, $self->{bpl});
31
32	not $trailing_crlf and $str =~ s/(\n|\r|\x0d\x0a)$//o;
33
34	return $str;
35}
36
37
38sub _mime_unstructured_header {
39    my ($oldheader, $bpl) = @_;
40	my $crlf = $oldheader =~ /\n$/;
41	my($header, @words, @wordstmp, $i) = ('');
42
43	$oldheader =~ s/\s+$//;
44
45	@wordstmp = split /\s+/, $oldheader;
46
47	for ($i = 0; $i < $#wordstmp; $i++){
48		if( $wordstmp[$i] !~ /^[\x21-\x7E]+$/ and $wordstmp[$i + 1] !~ /^[\x21-\x7E]+$/){
49			$wordstmp[$i + 1] = "$wordstmp[$i] $wordstmp[$i + 1]";
50		}
51		else{
52			push(@words, $wordstmp[$i]);
53		}
54	}
55
56	push(@words, $wordstmp[-1]);
57
58	for my $word (@words){
59		if ($word =~ /^[\x21-\x7E]+$/) {
60			$header =~ /(?:.*\n)*(.*)/;
61			if (length($1) + length($word) > $bpl) {
62				$header .= "\n $word";
63			}
64			else{
65				$header .= $word;
66			}
67		}
68		else{
69			$header = _add_encoded_word($word, $header, $bpl);
70		}
71
72		$header =~ /(?:.*\n)*(.*)/;
73
74		if(length($1) == $bpl){
75			$header .= "\n ";
76		}
77		else {
78			$header .= ' ';
79		}
80	}
81
82	$header =~ s/\n? $//mg;
83
84	$crlf ? "$header\n" : $header;
85}
86
87
88sub _add_encoded_word {
89	my($str, $line, $bpl) = @_;
90	my $result = '';
91
92	while( length($str) ){
93		my $target = $str;
94		$str = '';
95
96		if(length($line) + 22 + ($target =~ /^(?:$RE{EUC_0212}|$RE{EUC_C})/o) * 8 > $bpl){
97			$line =~ s/[ \t\n\r]*$/\n/;
98			$result .= $line;
99			$line = ' ';
100		}
101
102		while(1){
103			my $iso_2022_jp = $target;
104			Encode::from_to($iso_2022_jp, 'euc-jp', 'iso-2022-jp');
105
106			my $encoded
107			 = HEAD . MIME::Base64::encode_base64($iso_2022_jp, '') . TAIL;
108
109			if(length($encoded) + length($line) > $bpl){
110				$target =~ s/($RE{EUC_0212}|$RE{EUC_KANA}|$RE{EUC_C}|$RE{ASCII})$//o;
111				$str = $1 . $str;
112			}
113			else{
114				$line .= $encoded;
115				last;
116			}
117		}
118
119	}
120
121	$result . $line;
122}
123
124
1251;
126__END__
127
128