1BEGIN { 2 require Config; Config->import(); 3 if ($Config{'extensions'} !~ /\bEncode\b/) { 4 print "1..0 # Skip: Encode was not built\n"; 5 exit 0; 6 } 7 if (ord("A") == 193) { 8 print "1..0 # Skip: EBCDIC\n"; 9 exit 0; 10 } 11# should work w/o PerlIO now! 12# unless (PerlIO::Layer->find('perlio')){ 13# print "1..0 # Skip: PerlIO required\n"; 14# exit 0; 15# } 16 $| = 1; 17} 18use strict; 19use Test::More tests => 60; 20use Encode; 21use File::Basename; 22use File::Spec; 23use File::Compare qw(compare_text); 24our $DEBUG = shift || 0; 25 26my %Charset = 27 ( 28 'big5-eten' => [qw(big5-eten)], 29 'big5-hkscs' => [qw(big5-hkscs)], 30 gb2312 => [qw(euc-cn hz)], 31 jisx0201 => [qw(euc-jp shiftjis 7bit-jis)], 32 jisx0208 => [qw(euc-jp shiftjis 7bit-jis iso-2022-jp iso-2022-jp-1)], 33 jisx0212 => [qw(euc-jp 7bit-jis iso-2022-jp-1)], 34 ksc5601 => [qw(euc-kr iso-2022-kr johab)], 35 ); 36 37 38my $dir = dirname(__FILE__); 39my $seq = 1; 40 41for my $charset (sort keys %Charset){ 42 my ($src, $uni, $dst, $txt); 43 44 my $transcoder = find_encoding($Charset{$charset}[0]) or die; 45 46 my $src_enc = File::Spec->catfile($dir,"$charset.enc"); 47 my $src_utf = File::Spec->catfile($dir,"$charset.utf"); 48 my $dst_enc = File::Spec->catfile($dir,"$$.enc"); 49 my $dst_utf = File::Spec->catfile($dir,"$$.utf8"); 50 51 open $src, "<$src_enc" or die "$src_enc : $!"; 52 53 if (PerlIO::Layer->find('perlio')){ 54 binmode($src, ":bytes"); # needed when :utf8 in default open layer 55 } 56 57 $txt = join('',<$src>); 58 close($src); 59 60 eval { $uni = $transcoder->decode($txt, 1) } or print $@; 61 ok(defined($uni), "decode $charset"); $seq++; 62 is(length($txt),0, "decode $charset completely"); $seq++; 63 64 open $dst, ">$dst_utf" or die "$dst_utf : $!"; 65 if (PerlIO::Layer->find('perlio')){ 66 binmode($dst, ":utf8"); 67 print $dst $uni; 68 }else{ # ugh! 69 binmode($dst); 70 my $raw = $uni; Encode::_utf8_off($raw); 71 print $dst $raw; 72 } 73 74 close($dst); 75 is(compare_text($dst_utf, $src_utf), 0, "$dst_utf eq $src_utf") 76 or ($DEBUG and rename $dst_utf, "$dst_utf.$seq"); 77 $seq++; 78 79 open $src, "<$src_utf" or die "$src_utf : $!"; 80 if (PerlIO::Layer->find('perlio')){ 81 binmode($src, ":utf8"); 82 $uni = join('', <$src>); 83 }else{ # ugh! 84 binmode($src); 85 $uni = join('', <$src>); 86 Encode::_utf8_on($uni); 87 } 88 close $src; 89 90 my $unisave = $uni; 91 eval { $txt = $transcoder->encode($uni,1) } or print $@; 92 ok(defined($txt), "encode $charset"); $seq++; 93 is(length($uni), 0, "encode $charset completely"); $seq++; 94 $uni = $unisave; 95 96 open $dst,">$dst_enc" or die "$dst_utf : $!"; 97 binmode($dst); 98 print $dst $txt; 99 close($dst); 100 is(compare_text($src_enc, $dst_enc), 0 => "$dst_enc eq $src_enc") 101 or ($DEBUG and rename $dst_enc, "$dst_enc.$seq"); 102 $seq++; 103 104 unlink($dst_utf, $dst_enc); 105 106 for my $encoding (@{$Charset{$charset}}){ 107 my $rt = decode($encoding, encode($encoding, $uni)); 108 is ($rt, $uni, "RT $encoding"); 109 } 110} 111