1#!../perl 2 3BEGIN { 4 if ($ENV{'PERL_CORE'}){ 5 chdir 't'; 6 unshift @INC, '../lib'; 7 } 8 require Config; import Config; 9 if ($Config{'extensions'} !~ /\bEncode\b/) { 10 print "1..0 # Skip: Encode was not built\n"; 11 exit 0; 12 } 13} 14 15use strict; 16use Encode; 17use Encode::Alias; 18my %a2c; 19my $ON_EBCDIC; 20 21sub init_a2c{ 22 %a2c = ( 23 'US-ascii' => 'ascii', 24 'ISO-646-US' => 'ascii', 25 'UTF-8' => 'utf8', 26 'UCS-2' => 'UCS-2BE', 27 'UCS2' => 'UCS-2BE', 28 'iso-10646-1' => 'UCS-2BE', 29 'ucs2-le' => 'UCS-2LE', 30 'ucs2-be' => 'UCS-2BE', 31 'utf16' => 'UTF-16', 32 'utf32' => 'UTF-32', 33 'utf16-be' => 'UTF-16BE', 34 'utf32-be' => 'UTF-32BE', 35 'utf16-le' => 'UTF-16LE', 36 'utf32-le' => 'UTF-32LE', 37 'UCS4-BE' => 'UTF-32BE', 38 'UCS-4-LE' => 'UTF-32LE', 39 'cyrillic' => 'iso-8859-5', 40 'arabic' => 'iso-8859-6', 41 'greek' => 'iso-8859-7', 42 'hebrew' => 'iso-8859-8', 43 'thai' => 'iso-8859-11', 44 'tis620' => 'iso-8859-11', 45 'WinLatin1' => 'cp1252', 46 'WinLatin2' => 'cp1250', 47 'WinCyrillic' => 'cp1251', 48 'WinGreek' => 'cp1253', 49 'WinTurkish' => 'cp1254', 50 'WinHebrew' => 'cp1255', 51 'WinArabic' => 'cp1256', 52 'WinBaltic' => 'cp1257', 53 'WinVietnamese' => 'cp1258', 54 'koi8r' => 'koi8-r', 55 'koi8u' => 'koi8-u', 56 'ja_JP.euc' => $ON_EBCDIC ? '' : 'euc-jp', 57 'x-euc-jp' => $ON_EBCDIC ? '' : 'euc-jp', 58 'zh_CN.euc' => $ON_EBCDIC ? '' : 'euc-cn', 59 'x-euc-cn' => $ON_EBCDIC ? '' : 'euc-cn', 60 'ko_KR.euc' => $ON_EBCDIC ? '' : 'euc-kr', 61 'x-euc-kr' => $ON_EBCDIC ? '' : 'euc-kr', 62 'ujis' => $ON_EBCDIC ? '' : 'euc-jp', 63 'Shift_JIS' => $ON_EBCDIC ? '' : 'shiftjis', 64 'x-sjis' => $ON_EBCDIC ? '' : 'shiftjis', 65 'jis' => $ON_EBCDIC ? '' : '7bit-jis', 66 'big-5' => $ON_EBCDIC ? '' : 'big5-eten', 67 'zh_TW.Big5' => $ON_EBCDIC ? '' : 'big5-eten', 68 'tca-big5' => $ON_EBCDIC ? '' : 'big5-eten', 69 'big5-hk' => $ON_EBCDIC ? '' : 'big5-hkscs', 70 'hkscs-big5' => $ON_EBCDIC ? '' : 'big5-hkscs', 71 'GB_2312-80' => $ON_EBCDIC ? '' : 'euc-cn', 72 'KS_C_5601-1987' => $ON_EBCDIC ? '' : 'cp949', 73 # 74 'gb12345-raw' => $ON_EBCDIC ? '' : 'gb12345-raw', 75 'gb2312-raw' => $ON_EBCDIC ? '' : 'gb2312-raw', 76 'jis0201-raw' => $ON_EBCDIC ? '' : 'jis0201-raw', 77 'jis0208-raw' => $ON_EBCDIC ? '' : 'jis0208-raw', 78 'jis0212-raw' => $ON_EBCDIC ? '' : 'jis0212-raw', 79 'ksc5601-raw' => $ON_EBCDIC ? '' : 'ksc5601-raw', 80 ); 81 82 for my $i (1..11,13..16){ 83 $a2c{"ISO 8859 $i"} = "iso-8859-$i"; 84 } 85 for my $i (1..10){ 86 $a2c{"ISO Latin $i"} = "iso-8859-$Encode::Alias::Latin2iso[$i]"; 87 } 88 for my $k (keys %Encode::Alias::Winlatin2cp){ 89 my $v = $Encode::Alias::Winlatin2cp{$k}; 90 $a2c{"Win" . ucfirst($k)} = "cp" . $v; 91 $a2c{"IBM-$v"} = $a2c{"MS-$v"} = "cp" . $v; 92 $a2c{"cp-" . $v} = "cp" . $v; 93 } 94 my @a2c = keys %a2c; 95 for my $k (@a2c){ 96 $a2c{uc($k)} = $a2c{$k}; 97 $a2c{lc($k)} = $a2c{$k}; 98 $a2c{lcfirst($k)} = $a2c{$k}; 99 $a2c{ucfirst($k)} = $a2c{$k}; 100 } 101} 102 103BEGIN{ 104 $ON_EBCDIC = ord("A") == 193; 105 @ARGV and $ON_EBCDIC = $ARGV[0] eq 'EBCDIC'; 106 $Encode::ON_EBCDIC = $ON_EBCDIC; 107 init_a2c(); 108} 109 110if ($ON_EBCDIC){ 111 delete @Encode::ExtModule{ 112 qw(euc-cn gb2312 gb12345 gbk cp936 iso-ir-165 MacChineseSimp 113 euc-jp iso-2022-jp 7bit-jis shiftjis MacJapanese cp932 114 euc-kr ksc5601 cp949 MacKorean 115 big5 big5-hkscs cp950 MacChineseTrad 116 gb18030 big5plus euc-tw) 117 }; 118} 119 120use Test::More tests => (scalar keys %a2c) * 4; 121 122print "# alias test; \$ON_EBCDIC == $ON_EBCDIC\n"; 123 124foreach my $a (keys %a2c){ 125 my $e = Encode::find_encoding($a); 126 is((defined($e) and $e->name), $a2c{$a},$a) 127 or warn "alias was $a";; 128} 129 130# now we override some of the aliases and see if it works fine 131 132define_alias( 133 qr/ascii/i => 'WinLatin1', 134 qr/cyrillic/i => 'WinCyrillic', 135 qr/arabic/i => 'WinArabic', 136 qr/greek/i => 'WinGreek', 137 qr/hebrew/i => 'WinHebrew' 138 ); 139 140print "# alias test with alias overrides\n"; 141 142foreach my $a (keys %a2c){ 143 my $e = Encode::find_encoding($a); 144 is((defined($e) and $e->name), $a2c{$a}, "Override $a") 145 or warn "alias was $a"; 146} 147 148print "# alias undef test\n"; 149 150Encode::Alias->undef_aliases; 151foreach my $a (keys %a2c){ 152 my $e = Encode::find_encoding($a); 153 ok(!defined($e) || $e->name =~ /-raw$/o,"Undef $a") 154 or warn "alias was $a"; 155} 156 157print "# alias reinit test\n"; 158 159Encode::Alias->init_aliases; 160init_a2c(); 161foreach my $a (keys %a2c){ 162 my $e = Encode::find_encoding($a); 163 is((defined($e) and $e->name), $a2c{$a}, "Reinit $a") 164 or warn "alias was $a"; 165} 166__END__ 167for my $k (keys %a2c){ 168 $k =~ /[A-Z]/ and next; 169 print "$k => $a2c{$k}\n"; 170} 171 172 173 174