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