/[suikacvs]/www/test/charset/646variant/yentilde.cgi
Suika

Contents of /www/test/charset/646variant/yentilde.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (hide annotations) (download)
Tue Dec 5 11:37:21 2006 UTC (18 years, 7 months ago) by wakaba
Branch: MAIN
CVS Tags: HEAD
Was not part of CVS repository

1 wakaba 1.1 #!/usr/bin/perl
2    
3     my $charset = 'iso-2022-jp';
4     my %charset = qw/iso-2022-jp 1 iso-2022-jp-1 1 iso-2022-jp-2 1 iso-2022-jp-3 1
5     iso-2022-jp-2004 1
6     euc-jp 1 euc-jisx0213 1 euc-jis-2004 1
7     shift_jis 1 shift_jisx0213 1
8     shift_jis-2004 1 windows-31j 1
9     us-ascii 1 iso-8859-1 1 utf-8 1/;
10    
11     my $type = 'text/html';
12     my %type = qw!text/html 1 application/xhtml+xml 1
13     application/vnd.wap.xhtml+xml 1
14     application/vnd.pwg-xhtml-print+xml 1
15     application/xv+xml 1
16     application/xhtml+voice+xml 1
17     application/xhtml-voice+xml 1
18     application/x-xhtml+voice+xml 1
19     text/xml 1 application/xml 1!;
20    
21     for (split /[&;]/, $ENV{QUERY_STRING}) {
22     my ($name, $val) = split /=/, $_, 2;
23     $val =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/chr hex $1/ge;
24     if ($name eq 'charset') {
25     $charset = $val if $charset{$val};
26     } elsif ($name eq 'type') {
27     $type = $val if $type{$val};
28     }
29     }
30    
31     use Encode;
32    
33     my $thead = <<EOH;
34     <thead>
35     <tr><th></th><th>lang=ja</th><th>lang=en</th><th></th><th>name</th></tr>
36     </thead>
37     EOH
38    
39     sub c ($) {
40     qq(<td>$_[0]</td><td lang="ja" xml:lang="ja">$_[0]</td><td lang="en" xml:lang="en">$_[0]</td>);
41     }
42    
43     my $ua = $ENV{HTTP_USER_AGENT};
44     $ua =~ s/([^\x20-\x24\x27-\x3B\x3D\x3F-\x7E])/sprintf '%%%02X', ord $1/ges;
45    
46     print <<EOH;
47     Content-Type: $type; charset=$charset
48    
49     <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
50     "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
51     <html xmlns="http://www.w3.org/1999/xhtml">
52     <head>
53     <title>$type; charset=$charset</title>
54     <meta http-equiv="content-type" content="$type; charset=$charset" />
55     </head>
56     <body>
57     <table>
58     $thead
59     <tbody>
60     <tr>@{[c(qq(\x5C))]}<td>0x5C</td><td>@{[
61     ({qw/shift_jis 1 shift_jisx0213 1 shift_jis-2004 1/}->{$charset})
62     ? 'YEN SIGN'
63     : (({qw/windows-31j 1/}->{$charset})
64     ? 'REVERSE SOLIDUS (with glyph of YEN SIGN)'
65     : 'REVERSE SOLIDUS') ]}</td></tr>
66     @{[ ({qw/iso-2022-jp 1 iso-2022-jp-1 1 iso-2022-jp-2 1
67     iso-2022-jp-3 1 iso-2022-jp-2004 1/}->{$charset} ) ?
68     qq{<tr>@{[c(qq{\x1B\x28\x4A\x5C\x1B\x28\x42})]}<td>ESC 02/08 04/10 05/12</td><td>YEN SIGN</td></tr>}
69     :'']}
70     <tr>@{[c(qq{&#x5C;})]}<td>&amp;#x5C;</td><td>REVERSE SOLIDUS</td></tr>
71    
72     @{[ ($charset eq 'utf-8') ?
73     qq(<tr>@{[c(Encode::encode ('utf8', "\xA5"))]}<td>0xA5</td><td>YEN SIGN</td></tr>)
74     :($charset eq 'iso-8859-1')
75     ?qq(<tr>@{[c(qq{\xA5})]}<td>U+00A5</td><td>YEN SIGN</td></tr>)
76     :'']}
77     <tr>@{[c(qq{&#xA5;})]}<td>&amp;#xA5;</td><td>YEN SIGN</td></tr>
78     <tr>@{[c(qq{&yen;})]}<td>&amp;yen;</td><td>YEN SIGN</td></tr>
79    
80     @{[ ({qw/shift_jis 1 shift_jisx0213 1 shift_jis-2004 1/}->{$charset})
81     ?qq(<tr>@{[c(qq{\x81\x5F})]}<td>0x815F</td><td>REVERSE SOLIDUS</td></tr>)
82     :($charset eq 'windows-31j')
83     ?qq(<tr>@{[c(qq{\x81\x5F})]}<td>0x815F</td><td>FULLWIDTH REVERSE SOLIDUS</td></tr>)
84     :($charset =~ /iso-2022-jp/)
85     ?qq{<tr>@{[c(qq{\x1B\x24\x42\x21\x40\x1B\x28\x42})]}<td>ESC 02/04 04/02 02/01 04/00</td><td>REVERSE SOLIDUS</td></tr>}
86     :({qw/euc-jp 1 euc-jisx0213 1 euc-jis-2004 1/}->{$charset})
87     ?qq(<tr>@{[c(qq{\xA1\xC0})]}<td>0xA1C0</td><td>(REVERSE SOLIDUS) or FULLWIDTH REVERSE SOLIDUS</td></tr>)
88     :'']}
89     @{[ ($charset eq 'iso-2022-jp' || $charset eq 'iso-2022-jp-1'
90     || $charset eq 'iso-2022-jp-2')
91     ?qq{<tr>@{[c(qq{\x1B\x24\x40\x21\x40\x1B\x28\x42})]}<td>ESC 02/04 04/00 02/01 04/00</td><td>REVERSE SOLIDUS</td></tr>}
92     :({qw/iso-2022-jp-3 1 iso-2022-jp-2004 1/}->{$charset})
93     ?qq{<tr>@{[c(qq{\x1B\x24\x28\x4F\x21\x40\x1B\x28\x42})]}<td>ESC 02/04 04/15 02/01 04/00</td><td>REVERSE SOLIDUS</td></tr>}
94     :'']}
95     @{[
96     ({qw/iso-2022-jp-2004 1/}->{$charset})
97     ?qq{<tr>@{[c(qq{\x1B\x24\x28\x51\x21\x40\x1B\x28\x42})]}<td>ESC 02/04 05/01 02/01 04/00</td><td>REVERSE SOLIDUS</td></tr>}
98     :'']}
99    
100     @{[ ({qw/shift_jis 1 shift_jisx0213 1 shift_jis-2004 1/}->{$charset})
101     ?qq(<tr>@{[c(qq{\x81\x8F})]}<td>0x818F</td><td>(YEN SIGN) or FULLWIDTH YEN SIGN</td></tr>)
102     :($charset eq 'windows-31j')
103     ?qq(<tr>@{[c(qq{\x81\x8F})]}<td>0x818F</td><td>FULLWIDTH YEN SIGN</td></tr>)
104     :($charset =~ /iso-2022-jp/)
105     ?qq{<tr>@{[c(qq{\x1B\x24\x42\x21\x6F\x1B\x28\x42})]}<td>ESC 02/04 04/02 02/01 06/15</td><td>YEN SIGN</td></tr>}
106     :({qw/euc-jp 1 euc-jisx0213 1 euc-jp-2004 1/}->{$charset})
107     ?qq(<tr>@{[c(qq{\xA1\xEF})]}<td>0xA1EF</td><td>YEN SIGN</td></tr>)
108     :'']}
109     @{[ ($charset eq 'iso-2022-jp' || $charset eq 'iso-2022-jp-1'
110     || $charset eq 'iso-2022-jp-2')
111     ?qq{<tr>@{[c(qq{\x1B\x24\x40\x21\x6F\x1B\x28\x42})]}<td>ESC 02/04 04/00 02/01 06/15</td><td>YEN SIGN</td></tr>}
112     :({qw/iso-2022-jp-3 1 iso-2022-jp-2004 1/}->{$charset})
113     ?qq{<tr>@{[c(qq{\x1B\x24\x28\x4F\x21\x6F\x1B\x28\x42})]}<td>ESC 02/04 04/15 02/01 06/15</td><td>YEN SIGN</td></tr>}
114     :'']}
115     @{[
116     ({qw/iso-2022-jp-2004 1/}->{$charset})
117     ?qq{<tr>@{[c(qq{\x1B\x24\x28\x51\x21\x6F\x1B\x28\x42})]}<td>ESC 02/04 05/01 02/01 06/15</td><td>YEN SIGN</td></tr>}
118     :'']}
119     @{[ ($charset eq 'iso-2022-jp-2')
120     ?qq{<tr>@{[c(qq{\x1B\x2E\x41\x1B\x4E\x25\x1B\x28\x42})]}<td>ESC 02/14 04/01 SS2 02/05</td><td>YEN SIGN</td></tr>}
121     :'']}
122    
123     @{[($charset eq 'utf-8')
124     ?qq(<tr>@{[c(Encode::encode('utf8',"\x{FF3C}"))]}<td>U+FF3C</td><td>FULLWIDTH REVERSE SOLIDUS</td></tr>)
125     :'']}
126     <tr>@{[c(qq{&#xFF3C;})]}<td>&amp;#xFF3C;</td><td>FULLWIDTH REVERSE SOLIDUS</td></tr>
127     @{[($charset eq 'utf-8')
128     ?qq(<tr>@{[c(Encode::encode('utf8',"\x{FFE5}"))]}<td>U+FFE5</td><td>FULLWIDTH YEN SIGN</td></tr>)
129     :'']}
130     <tr>@{[c(qq{&#xFFE5;})]}<td>&amp;#xFFE5;</td><td>FULLWIDTH YEN SIGN</td></tr>
131    
132     </tbody>
133     </table>
134    
135     <table>
136     $thead
137     <tbody>
138     <tr>@{[c(qq(\x7E))]}<td>0x7E</td><td>@{[
139     ({qw/shift_jis 1 shift_jisx0213 1 shift_jis-2004 1/}->{$charset})
140     ? 'OVER LINE or OVER LINE with glyph of TILDE'
141     : 'TILDE' ]}</td></tr>
142     @{[ ($charset eq 'iso-2022-jp' || $charset eq 'iso-2022-jp-1' || $charset eq 'iso-2022-jp-2') ?
143     qq{<tr>@{[c(qq{\x1B\x28\x4A\x7E\x1B\x28\x42})]}<td>ESC 02/08 04/10 07/14</td><td>OVER LINE</td></tr>}
144     :'']}
145     <tr>@{[c(qq{&#x7E;})]}<td>&amp;#x7E;</td><td>TILDE</td></tr>
146     <tr>@{[c(qq{&tilde;})]}<td>&amp;tilde;</td><td>TILDE</td></tr>
147    
148     @{[ ({qw/shift_jis 1 shift_jisx0213 1 shift_jis-2004 1/}->{$charset})
149     ?qq(<tr>@{[c(qq{\x81\x50})]}<td>0x8150</td><td>(OVER LINE) or FULLWIDTH OVER LINE</td></tr>)
150     :($charset eq 'windows-31j')
151     ?qq(<tr>@{[c(qq{\x81\x50})]}<td>0x8150</td><td>FULLWIDTH OVER LINE</td></tr>)
152     :($charset =~ /iso-2022-jp/)
153     ?qq{<tr>@{[c(qq{\x1B\x24\x42\x21\x31\x1B\x28\x42})]}<td>ESC 02/04 04/02 02/01 03/01</td><td>OVER LINE</td></tr>}
154     :({qw/euc-jp 1 euc-jisx0213 1 euc-jis-2004 1/}->{$charset})
155     ?qq(<tr>@{[c(qq{\xA1\xB1})]}<td>0xA1B1</td><td>OVER LINE</td></tr>)
156     :'']}
157     @{[ ($charset eq 'iso-2022-jp' || $charset eq 'iso-2022-jp-1'
158     || $charset eq 'iso-2022-jp-2')
159     ?qq{<tr>@{[c(qq{\x1B\x24\x40\x21\x31\x1B\x28\x42})]}<td>ESC 02/04 04/00 02/01 03/01</td><td>OVER LINE</td></tr>}
160     :({qw/iso-2022-jp-3 1 iso-2022-jp-2004 1/}->{$charset})
161     ?qq{<tr>@{[c(qq{\x1B\x24\x28\x4F\x21\x31\x1B\x28\x42})]}<td>ESC 02/04 04/15 02/01 03/01</td><td>OVER LINE</td></tr>}
162     :($charset eq 'utf-8')
163     ?qq(<tr>@{[c(Encode::encode('utf8',"\x{203E}"))]}<td>U+203E</td><td>OVER LINE</td></tr>)
164     :'']}
165     @{[
166     ({qw/iso-2022-jp-2004 1/}->{$charset})
167     ?qq{<tr>@{[c(qq{\x1B\x24\x28\x51\x21\x31\x1B\x28\x42})]}<td>ESC 02/04 05/01 02/01 03/01</td><td>OVER LINE</td></tr>}
168     :'']}
169     <tr>@{[c(qq{&#x203E;})]}<td>&amp;#x203E;</td><td>OVER LINE</td></tr>
170    
171     @{[ ({qw/shift_jis 1 shift_jisx0213 1 shift_jis-2004 1/}->{$charset})
172     ?qq(<tr>@{[c(qq{\x81\x60})]}<td>0x8160</td><td>WAVE DASH</td></tr>)
173     :($charset eq 'windows-31j')
174     ?qq(<tr>@{[c(qq{\x81\x60})]}<td>0x8160</td><td>FULLWIDTH TILDE</td></tr>)
175     :($charset =~ /iso-2022-jp/)
176     ?qq{<tr>@{[c(qq{\x1B\x24\x42\x21\x41\x1B\x28\x42})]}<td>ESC 02/04 04/02 02/01 04/01</td><td>WAVE DASH</td></tr>}
177     :({qw/euc-jp 1 euc-jisx0213 1 euc-jis-2004 1/}->{$charset})
178     ?qq(<tr>@{[c(qq{\xA1\xC1})]}<td>0xA1C1</td><td>WAVE DASH</td></tr>)
179     :'']}
180     @{[ ($charset eq 'iso-2022-jp' || $charset eq 'iso-2022-jp-1'
181     || $charset eq 'iso-2022-jp-2')
182     ?qq{<tr>@{[c(qq{\x1B\x24\x40\x21\x41\x1B\x28\x42})]}<td>ESC 02/04 04/00 02/01 04/01</td><td>WAVE DASH</td></tr>}
183     :({qw/iso-2022-jp-3 1 iso-2022-jp-2004 1/}->{$charset})
184     ?qq{<tr>@{[c(qq{\x1B\x24\x28\x4F\x21\x41\x1B\x28\x42})]}<td>ESC 02/04 04/15 02/01 04/01</td><td>WAVE DASH</td></tr>}
185     :($charset eq 'utf-8')
186     ?qq(<tr>@{[c(Encode::encode('utf8',"\x{301C}"))]}<td>U+301C</td><td>WAVE DASH</td></tr>)
187     :'']}
188     @{[
189     ({qw/iso-2022-jp-2004 1/}->{$charset})
190     ?qq{<tr>@{[c(qq{\x1B\x24\x28\x51\x21\x41\x1B\x28\x42})]}<td>ESC 02/04 05/01 02/01 04/01</td><td>WAVE DASH</td></tr>}
191     :'']}
192     <tr>@{[c(qq{&#x301C;})]}<td>&amp;#x301C;</td><td>WAVE DASH</td></tr>
193    
194     @{[ ($charset eq 'shift_jisx0213' or $charset eq 'shift_jis-2004')
195     ?qq(<tr>@{[c(qq{\x81\xB0})]}<td>0x81B0</td><td>TILDE</td></tr>)
196     :($charset eq 'iso-2022-jp-3' or $charset eq 'iso-2022-jp-2004')
197     ?qq{<tr>@{[c(qq{\x1B\x24\x28\x4F\x22\x32\x1B\x28\x42})]}<td>ESC 02/04 02/08 04/15 02/02 03/02</td><td>TILDE</td></tr>}
198     :($charset eq 'euc-jisx0213' or $charset eq 'euc-jis-2004')
199     ?qq(<tr>@{[c(qq{\xA2\xB2})]}<td>0xA2B2</td><td>(TILDE) or FULLWIDTH TILDE</td></tr>)
200     :'']}
201    
202     @{[ ({qw/iso-2022-jp-2004 1/}->{$charset})
203     ?qq{<tr>@{[c(qq{\x1B\x24\x28\x51\x22\x32\x1B\x28\x42})]}<td>ESC 02/04 02/08 05/01 02/02 03/02</td><td>TILDE</td></tr>}
204     :'']}
205    
206     @{[ ($charset eq 'iso-2022-jp-2' || $charset eq 'iso-2022-jp-1')
207     ?qq{<tr>@{[c(qq{\x1B\x24\x28\x44\x22\x37\x1B\x28\x42})]}<td>ESC 02/04 02/08 04/04 02/02 03/07</td><td>TILDE</td></tr>}
208     :({qw/euc-jp 1 euc-jisx0213 1 euc-jis-2004 1/}->{$charset})
209     ?qq(<tr>@{[c(qq{\x8F\xA2\xB7})]}<td>SS3 0xA2B7</td><td>TILDE or FULLWIDTH TILDE</td></tr>)
210     :'']}
211    
212    
213     @{[($charset eq 'utf-8')
214     ?qq(<tr>@{[c(Encode::encode('utf8',"\x{FF5E}"))]}<td>U+FF5E</td><td>FULLWIDTH TILDE</td></tr>)
215     :'']}
216     <tr>@{[c(qq{&#xFF5E;})]}<td>&amp;#xFF5E;</td><td>FULLWIDTH TILDE</td></tr>
217    
218     </tbody>
219     </table>
220    
221     <p>Your User Agent Name : $ua</p>
222    
223     <form action="yentilde.cgi" method="get">
224     <ul>
225     <li><label>Type : <select name="type">@{[join "\n", sort map {qq(<option value="$_"@{[$_ eq $type?q( selected="selected"):'']}>$_</option>)} keys %type]}</select></label></li>
226     <li><label>Charset : <select name="charset">@{[join "\n", sort map {qq(<option value="$_"@{[$_ eq $charset?q( selected="selected"):'']}>$_</option>)} keys %charset]}</select></label></li>
227     <li><input type="submit" /></li>
228     </ul>
229     </form>
230    
231     </body>
232     </html>
233     EOH
234    

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24