1BEGIN { 2 require Config; import Config; 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,"$$.utf"); 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) }; 61 $@ and print $@; 62 ok(defined($uni), "decode $charset"); $seq++; 63 is(length($txt),0, "decode $charset completely"); $seq++; 64 65 open $dst, ">$dst_utf" or die "$dst_utf : $!"; 66 if (PerlIO::Layer->find('perlio')){ 67 binmode($dst, ":utf8"); 68 print $dst $uni; 69 }else{ # ugh! 70 binmode($dst); 71 my $raw = $uni; Encode::_utf8_off($raw); 72 print $dst $raw; 73 } 74 75 close($dst); 76 is(compare_text($dst_utf, $src_utf), 0, "$dst_utf eq $src_utf") 77 or ($DEBUG and rename $dst_utf, "$dst_utf.$seq"); 78 $seq++; 79 80 open $src, "<$src_utf" or die "$src_utf : $!"; 81 if (PerlIO::Layer->find('perlio')){ 82 binmode($src, ":utf8"); 83 $uni = join('', <$src>); 84 }else{ # ugh! 85 binmode($src); 86 $uni = join('', <$src>); 87 Encode::_utf8_on($uni); 88 } 89 close $src; 90 91 my $unisave = $uni; 92 eval{ $txt = $transcoder->encode($uni,1) }; 93 $@ and print $@; 94 ok(defined($txt), "encode $charset"); $seq++; 95 is(length($uni), 0, "encode $charset completely"); $seq++; 96 $uni = $unisave; 97 98 open $dst,">$dst_enc" or die "$dst_utf : $!"; 99 binmode($dst); 100 print $dst $txt; 101 close($dst); 102 is(compare_text($src_enc, $dst_enc), 0 => "$dst_enc eq $src_enc") 103 or ($DEBUG and rename $dst_enc, "$dst_enc.$seq"); 104 $seq++; 105 106 unlink($dst_utf, $dst_enc); 107 108 for my $encoding (@{$Charset{$charset}}){ 109 my $rt = decode($encoding, encode($encoding, $uni)); 110 is ($rt, $uni, "RT $encoding"); 111 } 112} 113