X-Git-Url: http://git.shiar.nl/sheet.git/blobdiff_plain/a0ba9298856b2426c5c66b6d2f2b284d98cee594..bd4970d57dbf38e4c2b32d91c1395b87925b200c:/charset.plp

diff --git a/charset.plp b/charset.plp
index c9ef2b6..e9c4fcc 100644
--- 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";
 
 :>