ext/Encode/t/Aliases.t

   1 #!../perl
   2
   3 use strict;
   4 use Encode;
   5 use Encode::Alias;
   6
   7 BEGIN {
   8     if (ord("A") == 193) {
   9         print "1..0 # Skip: EBCDIC\n";
  10         exit 0;
  11     }
  12 }
  13
  14 my %a2c;
  15
  16 BEGIN {
  17         %a2c = (
  18                 'ascii'    => 'US-ascii',
  19                 'cyrillic' => 'iso-8859-5',
  20                 'arabic'   => 'iso-8859-6',
  21                 'greek'    => 'iso-8859-7',
  22                 'hebrew'   => 'iso-8859-8',
  23                 'thai'     => 'iso-8859-11',
  24                 'tis620'   => 'iso-8859-11',
  25                 'ja_JP.euc'     => 'euc-jp',
  26                 'x-euc-jp'      => 'euc-jp',
  27                 'zh_CN.euc'     => 'euc-cn',
  28                 'x-euc-cn'      => 'euc-cn',
  29                 'ko_KR.euc'     => 'euc-kr',
  30                 'x-euc-kr'      => 'euc-kr',
  31                 'ujis'          => 'euc-jp',
  32                 'Shift_JIS'     => 'shiftjis',
  33                 'x-sjis'        => 'shiftjis',
  34                 'jis'           => '7bit-jis',
  35                 'big-5'         => 'big5',
  36                 'zh_TW.Big5'    => 'big5',
  37                 'big5-hk'       => 'big5-hkscs',
  38                 'WinLatin1'     => 'cp1252',
  39                 'WinLatin2'     => 'cp1250',
  40                 'WinCyrillic'   => 'cp1251',
  41                 'WinGreek'      => 'cp1253',
  42                 'WinTurkish'    => 'cp1254',
  43                 'WinHebrew'     => 'cp1255',
  44                 'WinArabic'     => 'cp1256',
  45                 'WinBaltic'     => 'cp1257',
  46                 'WinVietnamese' => 'cp1258',
  47                 );
  48
  49         for my $i (1..11,13..16){
  50             $a2c{"ISO 8859 $i"} = "iso-8859-$i";
  51         }
  52         for my $i (1..10){
  53             $a2c{"ISO Latin $i"} = "iso-8859-$Encode::Alias::Latin2iso[$i]";
  54         }
  55         for my $k (keys %Encode::Alias::Winlatin2cp){
  56             my $v = $Encode::Alias::Winlatin2cp{$k};
  57             $a2c{"Win" . ucfirst($k)} = "cp" . $v;
  58             $a2c{"IBM-$v"} = "cp" . $v;
  59             $a2c{"MS-$v"} = "cp" . $v;
  60         }
  61 }
  62
  63 use Test::More tests => (scalar keys %a2c) * 3;
  64
  65 print "# alias test\n";
  66
  67 foreach my $a (keys %a2c){
  68     my $e = Encode::find_encoding($a);
  69     is((defined($e) and $e->name), $a2c{$a});
  70 }
  71
  72 # now we override some of the aliases and see if it works fine
  73
  74 define_alias( qr/shift.*jis$/i  => '"macjapan"' );
  75 define_alias( qr/sjis$/i        => '"cp932"' );
  76
  77 @a2c{qw(Shift_JIS x-sjis)} = qw(macjapan cp932);
  78
  79 print "# alias test with alias overrides\n";
  80
  81 foreach my $a (keys %a2c){
  82     my $e = Encode::find_encoding($a);
  83     is((defined($e) and $e->name), $a2c{$a});
  84 }
  85
  86 print "# alias undef test\n";
  87
  88 Encode::Alias->undef_aliases;
  89 foreach my $a (keys %a2c){
  90     my $e = Encode::find_encoding($a);
  91     ok(!defined($e));
  92 }
  93
  94 __END__
  95 for (my $i = 0; $i < @Encode::Alias::Alias; $i+=2){
  96     my ($k, $v) = @Encode::Alias::Alias[$i, $i+1];
  97     print "$k => $v\n";
  98 }
  99
 100