charset: configurable table inclusion

Completely customizable by specifying a path.

diff --git a/charset.plp b/charset.plp
index c9ef2b699501c55daf574b029e2316780d75d451..e9c4fcc7c0d323f2b34895096ad73aacae08339a 100644 (file)
--- a/charset.plp
+++ b/charset.plp
@@ -26,12 +26,24 @@ my $diinfo = do 'digraphs.inc.pl';
 my %di = map { $diinfo->{$_}->[0] => $_ } grep { ref $diinfo->{$_} }
        keys %$diinfo;
 
-use Encode qw(decode);
+use Encode qw(decode resolve_alias);
 # generate character table(s)
 # (~16x faster than decoding in loop;
 #  substr strings is twice as fast as splitting to an array)
-my @request = ('iso-8859-1', 'cp437');
-my @tables = map { decode($_, pack 'C*', 0..255) } @request;
+my %ALIAS = (
+       default => [qw(utf-8 iso-8859-1 cp437)],
+       0 => [qw(cp437 cp863)],
+       1 => [qw(iso-8859-1 cp1252 MacRoman cp850)],
+       2 => [qw(iso-8859-2 cp1250 cp852 MacCentralEurRoman MacCroatian MacRumanian)],
+       5 => [qw(koi8-f iso-8859-5 cp1251 MacCyrillic cp855 cp866)],
+       7 => [qw(iso-8859-7 cp1253 MacGreek cp737 cp869)],
+       8 => [qw(iso-8859-8 cp1255 MacHebrew cp862)],
+);
+my @request = grep { defined } map {
+       $_ ? (resolve_alias($_) or print("Encoding $_ unknown") && ()) : ();
+} map { defined $ALIAS{$_} ? @{ $ALIAS{$_} } : $_ }
+       $ENV{PATH_INFO} =~ /\w/ ? split(m{[/+\s]}, $ENV{PATH_INFO}) : 'default';
+my @tables = map { $_ eq 'utf-8-strict' ? undef : decode($_, pack 'C*', 0..255) } @request;
 my $NOCHAR = chr 0xFFFD;
 
 for my $cp437 (grep {$request[$_] eq 'cp437'} 0 .. $#request) {
@@ -50,12 +62,71 @@ sub quote {
        return $_;
 }
 
+sub printcell_utf8 {
+       my ($value) = @_;
+       if ($value <= 0x7F) {
+               print '<td rowspan="8" colspan="16" class="X di-a"',
+                         ' title="U+0000 – U+007F">Single byte ASCII'
+                       if $value == 0;
+       }
+       elsif ($value <= 0xBF) {
+               print '<td rowspan="4" colspan="16" class="X di-d"',
+                         '>Multi-byte continuation'
+                       if $value == 0x80;
+       }
+       elsif ($value <= 0xC1) {
+               print '<td colspan="2" class="X di-b" style="border-right:none; border-bottom:none"',
+                         ' title="U+0000 – U+007F">(Overl.)'
+                       if $value == 0xC0;
+       }
+       elsif ($value <= 0xDF) {
+               print '<td rowspan="2" colspan="14" class="X di-prop" style="border-left:none"',
+                         ' title="U+0080 – U+03FF">2-byte sequence start'
+                       if $value == 0xC2;
+               print '<td rowspan="1" colspan="16" class="X di-prop" style="border-top:none"',
+                         ' title="U+0400 – U+07FF">'
+                       if $value == 0xD0;
+       }
+       elsif ($value <= 0xEF) {
+               print '<td colspan="16" class="X di-prop"',
+                         ' title="U+0800 – U+FFFF">3-byte sequence start'
+                       if $value == 0xE0;
+       }
+       elsif ($value <= 0xF4) {
+               print '<td colspan="5" class="X di-prop" style="border-right:none"',
+                         ' title="U+1·0000 – U+10·FFFF">4-byte sequence'
+                       if $value == 0xF0;
+       }
+       elsif ($value <= 0xF7) {
+               print '<td colspan="3" class="X di-b" style="border-left:none"',
+                         ' title="U+11·0000 – U+1FF·FFFF">(Overflow)'
+                       if $value == 0xF5;
+       }
+       elsif ($value <= 0xFB) {
+               print '<td colspan="4" class="X di-b"',
+                         ' title="U+200·0000 – U+3FFF·FFFF">5-byte'
+                       if $value == 0xF8;
+       }
+       elsif ($value <= 0xFD) {
+               print '<td colspan="2" class="X di-b"',
+                         ' title="U+4000·0000 – 7FFFF·FFFF">6-byte'
+                       if $value == 0xFC;
+       }
+       elsif ($value <= 0xFF) {
+               print '<td colspan="2" class="di-invalid">Invalid'
+                       if $value == 0xFE;
+       }
+       else {
+               print "\n".'<td class="X">?';
+       }
+}
+
 print "<ul>\n";
 
 my @nibble = (0..9, 'A'..'F');
 for my $tablenum (0 .. $#tables) {
        print '<li><table class="glyphs">';
-       printf '<caption>%s</caption>', $request[$tablenum];
+       printf '<caption>%s</caption>', $request[$tablenum] eq 'utf-8-strict' ? 'UTF-8' : $request[$tablenum];
        print '<col>';
        for my $section (qw{thead}) {
                print "<$section><tr><th>↱";
@@ -66,6 +137,11 @@ for my $tablenum (0 .. $#tables) {
        for my $msb (0 .. $#nibble) {
                print '<tr><th>', $nibble[$msb];
                for my $lsb (0 .. $#nibble) {
+                       if ($request[$tablenum] eq 'utf-8-strict') {
+                               printcell_utf8(($msb<<4) + $lsb);
+                               next;
+                       }
+
                        my $glyph = substr $tables[$tablenum], ($msb<<4) + $lsb, 1;
                        if ($glyph eq $NOCHAR) {
                                print '<td>';
@@ -91,80 +167,6 @@ for my $tablenum (0 .. $#tables) {
        print "</table>\n";
 }
 
-{
-       print '<li><table class="glyphs"><caption>UTF-8</caption><col>';
-       for my $section (qw{thead}) {
-               print "<$section><tr><th>↱";
-               print '<th>', $_ for @nibble;
-               print "\n";
-       }
-       print '<tbody>';
-       print '<tr rowspan="8">';
-       for my $msb (0 .. $#nibble) {
-               print '<tr><th>', $nibble[$msb];
-               for my $lsb (0 .. $#nibble) {
-                       my $value = ($msb<<4) + $lsb;
-                       if ($value <= 0x7F) {
-                               print '<td rowspan="8" colspan="16" class="X di-a"',
-                                     ' title="U+0000 – U+007F">Single byte ASCII'
-                                       if $value == 0;
-                       }
-                       elsif ($value <= 0xBF) {
-                               print '<td rowspan="4" colspan="16" class="X di-d"',
-                                     '>Multi-byte continuation'
-                                       if $value == 0x80;
-                       }
-                       elsif ($value <= 0xC1) {
-                               print '<td colspan="2" class="X di-b" style="border-right:none; border-bottom:none"',
-                                     ' title="U+0000 – U+007F">(Overl.)'
-                                       if $value == 0xC0;
-                       }
-                       elsif ($value <= 0xDF) {
-                               print '<td rowspan="2" colspan="14" class="X di-prop" style="border-left:none"',
-                                     ' title="U+0080 – U+03FF">2-byte sequence start'
-                                       if $value == 0xC2;
-                               print '<td rowspan="1" colspan="16" class="X di-prop" style="border-top:none"',
-                                     ' title="U+0400 – U+07FF">'
-                                       if $value == 0xD0;
-                       }
-                       elsif ($value <= 0xEF) {
-                               print '<td colspan="16" class="X di-prop"',
-                                     ' title="U+0800 – U+FFFF">3-byte sequence start'
-                                       if $value == 0xE0;
-                       }
-                       elsif ($value <= 0xF4) {
-                               print '<td colspan="5" class="X di-prop" style="border-right:none"',
-                                     ' title="U+1·0000 – U+10·FFFF">4-byte sequence'
-                                       if $value == 0xF0;
-                       }
-                       elsif ($value <= 0xF7) {
-                               print '<td colspan="3" class="X di-b" style="border-left:none"',
-                                     ' title="U+11·0000 – U+1FF·FFFF">(Overflow)'
-                                       if $value == 0xF5;
-                       }
-                       elsif ($value <= 0xFB) {
-                               print '<td colspan="4" class="X di-b"',
-                                     ' title="U+200·0000 – U+3FFF·FFFF">5-byte'
-                                       if $value == 0xF8;
-                       }
-                       elsif ($value <= 0xFD) {
-                               print '<td colspan="2" class="X di-b"',
-                                     ' title="U+4000·0000 – 7FFFF·FFFF">6-byte'
-                                       if $value == 0xFC;
-                       }
-                       elsif ($value <= 0xFF) {
-                               print '<td colspan="2" class="di-invalid">Invalid'
-                                       if $value == 0xFE;
-                       }
-                       else {
-                               print "\n".'<td class="X">?';
-                       }
-               }
-               print "\n";
-       }
-       print "</table>\n";
-}
-
 print "</ul>\n";
 
 :>