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