Blame t/CJKT.t

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
}