Add files missed in change 25271

p4raw-id: //depot/perl@25273

diff --git a/ext/Encode/lib/Encode/MIME/Header/ISO_2022_JP.pm b/ext/Encode/lib/Encode/MIME/Header/ISO_2022_JP.pm
new file mode 100644 (file)
index 0000000..5f637a3
--- /dev/null
+++ b/ext/Encode/lib/Encode/MIME/Header/ISO_2022_JP.pm
@@ -0,0 +1,127 @@
+package Encode::MIME::Header::ISO_2022_JP;
+
+use strict;
+use base qw(Encode::MIME::Header);
+
+$Encode::Encoding{'MIME-Header-ISO_2022_JP'}
+  = bless {encode => 'B', bpl => 76, Name => 'MIME-Header-ISO_2022_JP'}
+   => __PACKAGE__;
+
+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
+
+sub encode {
+       my $self = shift;
+       my $str  = shift;
+
+       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;
+
+       return $str;
+}
+
+
+sub _mime_unstructured_header {
+    my ($oldheader, $bpl) = @_;
+       my $crlf = $oldheader =~ /\n$/;
+       my($header, @words, @wordstmp, $i) = ('');
+
+       $oldheader =~ s/\s+$//;
+
+       @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]";
+               }
+               else{
+                       push(@words, $wordstmp[$i]);
+               }
+       }
+
+       push(@words, $wordstmp[-1]);
+
+       for my $word (@words){
+               if ($word =~ /^[\x21-\x7E]+$/) {
+                       $header =~ /(?:.*\n)*(.*)/;
+                       if (length($1) + length($word) > $bpl) {
+                               $header .= "\n $word";
+                       }
+                       else{
+                               $header .= $word;
+                       }
+               }
+               else{
+                       $header = _add_encoded_word($word, $header, $bpl);
+               }
+
+               $header =~ /(?:.*\n)*(.*)/;
+
+               if(length($1) == $bpl){
+                       $header .= "\n ";
+               }
+               else {
+                       $header .= ' ';
+               }
+       }
+
+       $header =~ s/\n? $//mg;
+
+       $crlf ? "$header\n" : $header;
+}
+
+
+sub _add_encoded_word {
+       my($str, $line, $bpl) = @_;
+       my $result = '';
+
+       while( length($str) ){
+               my $target = $str;
+               $str = '';
+
+               if(length($line) + 22 + ($target =~ /^(?:$RE{EUC_0212}|$RE{EUC_C})/o) * 8 > $bpl){
+                       $line =~ s/[ \t\n\r]*$/\n/;
+                       $result .= $line;
+                       $line = ' ';
+               }
+
+               while(1){
+                       my $iso_2022_jp = $target;
+                       Encode::from_to($iso_2022_jp, 'euc-jp', 'iso-2022-jp');
+
+                       my $encoded
+                        = 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;
+                               $str = $1 . $str;
+                       }
+                       else{
+                               $line .= $encoded;
+                               last;
+                       }
+               }
+
+       }
+
+       $result . $line;
+}
+
+
+1;
+__END__
+

diff --git a/ext/Encode/t/mime_header_iso2022jp.t b/ext/Encode/t/mime_header_iso2022jp.t
new file mode 100644 (file)
index 0000000..ffc77e0
--- /dev/null
+++ b/ext/Encode/t/mime_header_iso2022jp.t
@@ -0,0 +1,40 @@
+
+use Test::More tests => 14;
+
+use strict;
+use Encode;
+
+BEGIN{
+       use_ok('Encode::MIME::Header::ISO_2022_JP');
+}
+
+require_ok('Encode::MIME::Header::ISO_2022_JP');
+
+#  below codes are from mime.t in Jcode
+
+my %mime = (
+       "´Á»ú¡¢¥«¥¿¥«¥Ê¡¢¤Ò¤é¤¬¤Ê"
+        => "=?ISO-2022-JP?B?GyRCNEE7eiEiJSslPyUrJUohIiRSJGkkLCRKGyhC?=",
+       "foo bar"
+        => "foo bar",
+       "´Á»ú¡¢¥«¥¿¥«¥Ê¡¢¤Ò¤é¤¬¤Ê¤Îº®¤¸¤Ã¤¿Subject Header."
+        => "=?ISO-2022-JP?B?GyRCNEE7eiEiJSslPyUrJUohIiRSJGkkLCRKJE46LiQ4JEMkPxsoQlN1?=\n =?ISO-2022-JP?B?YmplY3Q=?= Header.",
+);
+
+
+for my $k (keys %mime){
+    $mime{"$k\n"} = $mime{$k} . "\n";
+}
+
+
+for my $decoded (sort keys %mime){
+       my $encoded = $mime{$decoded};
+
+       my $header = Encode::encode('MIME-Header-ISO_2022_JP', decode('euc-jp', $decoded));
+       my $utf8   = Encode::decode('MIME-Header', $header);
+
+       is(encode('euc-jp', $utf8), $decoded);
+       is($header, $encoded);
+}
+
+__END__