1 package Encode::MIME::Header::ISO_2022_JP;
6 use base qw(Encode::MIME::Header);
8 $Encode::Encoding{'MIME-Header-ISO_2022_JP'} =
9 bless { encode => 'B', bpl => 76, Name => 'MIME-Header-ISO_2022_JP' } =>
12 use constant HEAD => '=?ISO-2022-JP?B?';
13 use constant TAIL => '?=';
15 use Encode::CJKConstants qw(%RE);
17 our $VERSION = do { my @r = ( q$Revision: 1.3 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r };
19 # I owe the below codes totally to
20 # Jcode by Dan Kogai & http://www.din.or.jp/~ohzaki/perl.htm#JP_Base64
26 utf8::encode($str) if ( Encode::is_utf8($str) );
27 Encode::from_to( $str, 'utf8', 'euc-jp' );
29 my ($trailing_crlf) = ( $str =~ /(\n|\r|\x0d\x0a)$/o );
31 $str = _mime_unstructured_header( $str, $self->{bpl} );
33 not $trailing_crlf and $str =~ s/(\n|\r|\x0d\x0a)$//o;
38 sub _mime_unstructured_header {
39 my ( $oldheader, $bpl ) = @_;
40 my $crlf = $oldheader =~ /\n$/;
41 my ( $header, @words, @wordstmp, $i ) = ('');
43 $oldheader =~ s/\s+$//;
45 @wordstmp = split /\s+/, $oldheader;
47 for ( $i = 0 ; $i < $#wordstmp ; $i++ ) {
48 if ( $wordstmp[$i] !~ /^[\x21-\x7E]+$/
49 and $wordstmp[ $i + 1 ] !~ /^[\x21-\x7E]+$/ )
51 $wordstmp[ $i + 1 ] = "$wordstmp[$i] $wordstmp[$i + 1]";
54 push( @words, $wordstmp[$i] );
58 push( @words, $wordstmp[-1] );
60 for my $word (@words) {
61 if ( $word =~ /^[\x21-\x7E]+$/ ) {
62 $header =~ /(?:.*\n)*(.*)/;
63 if ( length($1) + length($word) > $bpl ) {
64 $header .= "\n $word";
71 $header = _add_encoded_word( $word, $header, $bpl );
74 $header =~ /(?:.*\n)*(.*)/;
76 if ( length($1) == $bpl ) {
84 $header =~ s/\n? $//mg;
86 $crlf ? "$header\n" : $header;
89 sub _add_encoded_word {
90 my ( $str, $line, $bpl ) = @_;
93 while ( length($str) ) {
99 ( $target =~ /^(?:$RE{EUC_0212}|$RE{EUC_C})/o ) * 8 > $bpl )
101 $line =~ s/[ \t\n\r]*$/\n/;
107 my $iso_2022_jp = $target;
108 Encode::from_to( $iso_2022_jp, 'euc-jp', 'iso-2022-jp' );
111 HEAD . MIME::Base64::encode_base64( $iso_2022_jp, '' ) . TAIL;
113 if ( length($encoded) + length($line) > $bpl ) {
115 s/($RE{EUC_0212}|$RE{EUC_KANA}|$RE{EUC_C}|$RE{ASCII})$//o;