ext/Encode/t/CJKT.t

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