|
Packit |
d0f5c2 |
BEGIN {
|
|
Packit |
d0f5c2 |
require Config; import Config;
|
|
Packit |
d0f5c2 |
if ($Config{'extensions'} !~ /\bEncode\b/) {
|
|
Packit |
d0f5c2 |
print "1..0 # Skip: Encode was not built\n";
|
|
Packit |
d0f5c2 |
exit 0;
|
|
Packit |
d0f5c2 |
}
|
|
Packit |
d0f5c2 |
if (ord("A") == 193) {
|
|
Packit |
d0f5c2 |
print "1..0 # Skip: EBCDIC\n";
|
|
Packit |
d0f5c2 |
exit 0;
|
|
Packit |
d0f5c2 |
}
|
|
Packit |
d0f5c2 |
# should work w/o PerlIO now!
|
|
Packit |
d0f5c2 |
# unless (PerlIO::Layer->find('perlio')){
|
|
Packit |
d0f5c2 |
# print "1..0 # Skip: PerlIO required\n";
|
|
Packit |
d0f5c2 |
# exit 0;
|
|
Packit |
d0f5c2 |
# }
|
|
Packit |
d0f5c2 |
$| = 1;
|
|
Packit |
d0f5c2 |
}
|
|
Packit |
d0f5c2 |
use strict;
|
|
Packit |
d0f5c2 |
use Test::More tests => 60;
|
|
Packit |
d0f5c2 |
use Encode;
|
|
Packit |
d0f5c2 |
use File::Basename;
|
|
Packit |
d0f5c2 |
use File::Spec;
|
|
Packit |
d0f5c2 |
use File::Compare qw(compare_text);
|
|
Packit |
d0f5c2 |
our $DEBUG = shift || 0;
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
my %Charset =
|
|
Packit |
d0f5c2 |
(
|
|
Packit |
d0f5c2 |
'big5-eten' => [qw(big5-eten)],
|
|
Packit |
d0f5c2 |
'big5-hkscs' => [qw(big5-hkscs)],
|
|
Packit |
d0f5c2 |
gb2312 => [qw(euc-cn hz)],
|
|
Packit |
d0f5c2 |
jisx0201 => [qw(euc-jp shiftjis 7bit-jis)],
|
|
Packit |
d0f5c2 |
jisx0208 => [qw(euc-jp shiftjis 7bit-jis iso-2022-jp iso-2022-jp-1)],
|
|
Packit |
d0f5c2 |
jisx0212 => [qw(euc-jp 7bit-jis iso-2022-jp-1)],
|
|
Packit |
d0f5c2 |
ksc5601 => [qw(euc-kr iso-2022-kr johab)],
|
|
Packit |
d0f5c2 |
);
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
my $dir = dirname(__FILE__);
|
|
Packit |
d0f5c2 |
my $seq = 1;
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
for my $charset (sort keys %Charset){
|
|
Packit |
d0f5c2 |
my ($src, $uni, $dst, $txt);
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
my $transcoder = find_encoding($Charset{$charset}[0]) or die;
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
my $src_enc = File::Spec->catfile($dir,"$charset.enc");
|
|
Packit |
d0f5c2 |
my $src_utf = File::Spec->catfile($dir,"$charset.utf");
|
|
Packit |
d0f5c2 |
my $dst_enc = File::Spec->catfile($dir,"$$.enc");
|
|
Packit |
d0f5c2 |
my $dst_utf = File::Spec->catfile($dir,"$$.utf");
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
open $src, "<$src_enc" or die "$src_enc : $!";
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
if (PerlIO::Layer->find('perlio')){
|
|
Packit |
d0f5c2 |
binmode($src, ":bytes"); # needed when :utf8 in default open layer
|
|
Packit |
d0f5c2 |
}
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
$txt = join('',<$src>);
|
|
Packit |
d0f5c2 |
close($src);
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
eval { $uni = $transcoder->decode($txt, 1) } or print $@;
|
|
Packit |
d0f5c2 |
ok(defined($uni), "decode $charset"); $seq++;
|
|
Packit |
d0f5c2 |
is(length($txt),0, "decode $charset completely"); $seq++;
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
open $dst, ">$dst_utf" or die "$dst_utf : $!";
|
|
Packit |
d0f5c2 |
if (PerlIO::Layer->find('perlio')){
|
|
Packit |
d0f5c2 |
binmode($dst, ":utf8");
|
|
Packit |
d0f5c2 |
print $dst $uni;
|
|
Packit |
d0f5c2 |
}else{ # ugh!
|
|
Packit |
d0f5c2 |
binmode($dst);
|
|
Packit |
d0f5c2 |
my $raw = $uni; Encode::_utf8_off($raw);
|
|
Packit |
d0f5c2 |
print $dst $raw;
|
|
Packit |
d0f5c2 |
}
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
close($dst);
|
|
Packit |
d0f5c2 |
is(compare_text($dst_utf, $src_utf), 0, "$dst_utf eq $src_utf")
|
|
Packit |
d0f5c2 |
or ($DEBUG and rename $dst_utf, "$dst_utf.$seq");
|
|
Packit |
d0f5c2 |
$seq++;
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
open $src, "<$src_utf" or die "$src_utf : $!";
|
|
Packit |
d0f5c2 |
if (PerlIO::Layer->find('perlio')){
|
|
Packit |
d0f5c2 |
binmode($src, ":utf8");
|
|
Packit |
d0f5c2 |
$uni = join('', <$src>);
|
|
Packit |
d0f5c2 |
}else{ # ugh!
|
|
Packit |
d0f5c2 |
binmode($src);
|
|
Packit |
d0f5c2 |
$uni = join('', <$src>);
|
|
Packit |
d0f5c2 |
Encode::_utf8_on($uni);
|
|
Packit |
d0f5c2 |
}
|
|
Packit |
d0f5c2 |
close $src;
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
my $unisave = $uni;
|
|
Packit |
d0f5c2 |
eval { $txt = $transcoder->encode($uni,1) } or print $@;
|
|
Packit |
d0f5c2 |
ok(defined($txt), "encode $charset"); $seq++;
|
|
Packit |
d0f5c2 |
is(length($uni), 0, "encode $charset completely"); $seq++;
|
|
Packit |
d0f5c2 |
$uni = $unisave;
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
open $dst,">$dst_enc" or die "$dst_utf : $!";
|
|
Packit |
d0f5c2 |
binmode($dst);
|
|
Packit |
d0f5c2 |
print $dst $txt;
|
|
Packit |
d0f5c2 |
close($dst);
|
|
Packit |
d0f5c2 |
is(compare_text($src_enc, $dst_enc), 0 => "$dst_enc eq $src_enc")
|
|
Packit |
d0f5c2 |
or ($DEBUG and rename $dst_enc, "$dst_enc.$seq");
|
|
Packit |
d0f5c2 |
$seq++;
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
unlink($dst_utf, $dst_enc);
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
for my $encoding (@{$Charset{$charset}}){
|
|
Packit |
d0f5c2 |
my $rt = decode($encoding, encode($encoding, $uni));
|
|
Packit |
d0f5c2 |
is ($rt, $uni, "RT $encoding");
|
|
Packit |
d0f5c2 |
}
|
|
Packit |
d0f5c2 |
}
|