ext/Encode/t/CJKT.t

   1 BEGIN {
   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 }
  18 use strict;
  19 use Test::More tests => 60;
  20 use Encode;
  21 use File::Basename;
  22 use File::Spec;
  23 use File::Compare qw(compare_text);
  24 our $DEBUG = shift || 0;
  25
  26 my %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
  38 my $dir = dirname(__FILE__);
  39 my $seq = 1;
  40
  41 for 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 }