5 use open IO => ':utf8';
9 $header{content_type} = 'text/html; charset=utf-8';
11 :><!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
12 "http://www.w3.org/TR/html4/loose.dtd">
16 <title>charset cheat sheet</title>
17 <meta http-equiv="content-type" content="utf-8">
18 <link rel="stylesheet" type="text/css" media="all" href="/base.css">
22 <h1>Character encoding</h1>
25 my $diinfo = do 'digraphs.inc.pl';
26 my %di = map { $diinfo->{$_}->[0] => $_ } grep { ref $diinfo->{$_} }
29 use Encode qw(decode resolve_alias);
30 # generate character table(s)
31 # (~16x faster than decoding in loop;
32 # substr strings is twice as fast as splitting to an array)
34 # default => [qw(unicode utf-8 iso-8859-1 cp437 -cp1252- --iso-8859-15- -koi8-f)],
35 default => [qw(unicode- utf-8 iso-8859-1 -cp1252- --iso-8859-15- cp437 -cp850)],
36 0 => [qw(cp437 cp863)],
37 1 => [qw(iso-8859-1 cp1252 MacRoman cp850)],
38 2 => [qw(iso-8859-2 cp1250 cp852 MacCentralEurRoman MacCroatian MacRumanian)],
39 5 => [qw(koi8-f iso-8859-5 cp1251 MacCyrillic cp855 cp866)],
40 7 => [qw(iso-8859-7 cp1253 MacGreek cp737 cp869)],
41 8 => [qw(iso-8859-8 cp1255 MacHebrew cp862)],
45 my %row = (offset => 0);
47 if ($input =~ s/^--//) {
48 $row{offset} = $endpoint > 160 ? 160 : 48;
50 elsif ($input =~ s/^-//) {
51 $row{offset} = $endpoint > 128 ? 128 : 32;
53 if ($input =~ s/-$//) {
54 $endpoint = $row{offset} ? $row{offset} < 160 ? 159 : 191 : 127;
57 if ($input =~ /^U([0-9a-f]+)(?:-([0-9a-f]+))?/) {
58 my $start = hex($1) << ($2 ? 4 : 8);
59 my $end = $2 ? hex($2) << 4 : $start + 240;
60 $row{table} = join '', map { chr } $start .. $end+15;
61 utf8::upgrade($row{table}); # prevent latin1 output
62 $row{set} = sprintf 'Unicode block U+%02Xxx', $start >> 8;
64 elsif ($row{set} = resolve_alias($input)) {
65 if ($row{set} eq 'Internal') {
66 $row{table} = ' ' x ($endpoint < 255 ? 640 : 4096);
67 $row{set} = 'Unicode BMP';
68 $row{cell} = do 'charset-unicode.inc.pl';
70 elsif ($row{set} eq 'utf-8-strict') {
73 $row{cell} = do 'charset-utf8.inc.pl';
76 $row{table} = decode($row{set}, pack 'C*', $row{offset} .. $endpoint);
80 print "<p>Encoding $input unknown</p>\n";
87 } map { defined $ALIAS{$_} ? @{ $ALIAS{$_} } : $_ }
88 $ENV{PATH_INFO} =~ /\w/ ? split(m{[/+\s]}, $ENV{PATH_INFO}) : 'default';
89 my $NOCHAR = chr 0xFFFD;
91 for my $cp437 (grep {$request[$_]->{set} eq 'cp437'} 0 .. $#request) {
92 substr($request[$cp437]->{table}, 237, 1) = pack 'U*', 0x3D5; # phi sign
93 substr($request[$cp437]->{table}, 0, 32) = pack 'U*', map {hex} qw(
94 2007 263A 263B 2665 2666 2663 2660 2022 25D8 25CB 25D9 2642 2640 266A 266B 263C
95 25BA 25C4 2195 203C 00B6 00A7 25AC 21A8 2191 2193 2192 2190 221F 2194 25B2 25BC
109 my @nibble = (0..9, 'A'..'F');
110 for my $row (@request) {
111 printf '<li><table class="glyphs%s">', !$row->{cell} && ' charmap';
112 printf '<caption>%s</caption>', $row->{set};
114 for my $section (qw{thead}) {
115 print "<$section><tr><th>↱";
116 print '<th>', $_ for @nibble;
120 for my $msb (0 .. (length($row->{table}) || 256) - 1 >> 4) {
121 printf '<tr><th>%X', $msb + ($row->{offset} >> 4);
122 for my $lsb (0 .. $#nibble) {
124 print $row->{cell}->(($msb<<4) + $lsb);
128 my $glyph = substr $row->{table}, ($msb<<4) + $lsb, 1;
129 if ($glyph eq $NOCHAR) {
134 my $info = [ord $glyph];
135 if (defined (my $mnem = $di{ord $glyph})) {
136 $info = $diinfo->{$mnem};
138 my ($codepoint, $name, $prop, $script, $string) = @$info;
140 $glyph = quote($string || $glyph);
141 my $desc = sprintf 'U+%04X%s', $codepoint, $name && " ($name)";
142 my @class = ('X', grep {$_} $prop, $script);
144 $glyph = "<span>$glyph</span>" if $prop eq 'Zs';
146 printf "\n".'<td class="%s" title="%s">%s',
147 join(' ', @class), quote($desc), $glyph;
160 <table class="glyphs"><tr>
161 <td class="X Cc">control
162 <td class="X Zs"><span>whitespace</span>
163 <td class="X Mn">diacritic<table class="glyphs"><tr>
164 <td class="X Sk">letter
166 <td class="X Po">punctuation<table class="glyphs"><tr>
167 <td class="X Pf">quote
169 <td class="X So">symbol<table class="glyphs"><tr>
170 <td class="X Sm">math
171 <td class="X Sc">currency
173 <td class="X No">numeric
174 <td class="X Greek">greek<table class="glyphs"><tr>
175 <td class="X Latin">latin
176 <td class="X Cyrillic">cyrillic
178 <td class="X Aramaic">aramaic<table class="glyphs"><tr>
179 <td class="X Brahmic">brahmic
180 <td class="X Arabic">arabic
182 <td class="X Syllabic">syllabic<table class="glyphs"><tr>
183 <td class="X African">african
184 <td class="X Hiragana">japanese
185 <td class="X Han">cjk
186 <td class="X Bopomofo">chinese
188 <td class="X Alpha">alphabetic
191 <table class="glyphs"><tr>
192 <td class="X">unicode 5.0
193 <td class="X Xr">proposed
194 <td class="X Xd">deprecated
195 <td class="">unassigned
196 <td class="X Xi">invalid
201 <a href="http://sheet.shiar.nl/" rel="home">sheet.shiar.nl</a>/charset
202 <a href="git://git.shiar.nl/sheet" rel="vcs-git" title="Git repository"><:= "v$VERSION" :></a>
203 created by <a href="http://shiar.nl/" rel="author">Shiar</a> •
204 <a title="Licensed under the GNU Affero General Public License, version 3" rel="copyright"
205 href="http://www.fsf.org/licensing/licenses/agpl-3.0.html">AGPLv3</a> •
207 use Time::Format qw(time_format);
208 print time_format('yyyy-mm-dd', (stat $ENV{SCRIPT_FILENAME})[9]);