my @nibble = (0..9, 'A'..'F');
my $nibsize = 1;
-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 %ALIAS = (
# default => [qw(unicode utf-8 iso-8859-1 cp437 -cp1252- --iso-8859-15- -koi8-f)],
default => [qw(unicode- utf-8 iso-8859-1 -cp1252- --iso-8859-15- cp437 -cp850)],
- 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)],
+ 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 = map {
if (my $input = $_) {
if ($input =~ s/-$//) {
$endpoint = $row{offset} ? $row{offset} < 160 ? 159 : 191 : 127;
}
+ if ($row{offset}) {
+ $row{setnote} = 'over cp437' if $input eq 'cp850';
+ $row{setnote} = 'over iso-8859-1' if $input =~ /^iso-8859-|^cp125/;
+ }
if ($input =~ /^U([0-9a-f]+)(?:-([0-9a-f]+))?/) {
my $start = hex($1) << ($2 ? 4 : 8);
elsif ($input eq 'U') {
$row{table} = ' ' x 1024;
$row{set} = 'Unicode planes';
- $row{cell} = do 'charset-ucplanes.inc.pl';
+ $row{cell} = do 'charset-ucplanes.inc.pl'
+ or Alert('Table data could not be read', $@ || $!);
@nibble = (map { $_.0, $_.8 } 0 .. 7);
$nibsize = 8;
}
- elsif ($row{set} = resolve_alias($input)) {
+ elsif ($row{set} = Encode::resolve_alias($input)) {
if ($row{set} eq 'Internal') {
$row{table} = ' ' x ($endpoint < 255 ? 640 : 8192);
$row{set} = 'Unicode BMP';
- $row{cell} = do 'charset-unicode.inc.pl';
+ $row{cell} = do 'charset-unicode.inc.pl'
+ or Alert('Table data could not be read', $@ || $!);
}
elsif ($row{set} eq 'utf-8-strict') {
$row{table} = undef;
$row{set} = 'UTF-8';
- $row{cell} = do 'charset-utf8.inc.pl';
+ $row{cell} = do 'charset-utf8.inc.pl'
+ or Alert('Table data could not be read', $@ || $!);
}
else {
- $row{table} = decode($row{set}, pack 'C*', $row{offset} .. $endpoint);
+ $row{table} = Encode::decode($row{set}, pack 'C*', $row{offset} .. $endpoint);
}
}
else {
- print "<p>Encoding $input unknown</p>\n";
+ Alert("Encoding <q>$input</q> unknown");
}
- \%row;
+ $row{set} ? \%row : ();
}
else {
();
}
} map { defined $ALIAS{$_} ? @{ $ALIAS{$_} } : $_ }
- $ENV{PATH_INFO} =~ /\w/ ? split(m{[/+\s]}, $ENV{PATH_INFO}) : 'default';
+ $Request =~ /\w/ ? split(m{[/+\s]}, $Request) : 'default';
my $NOCHAR = chr 0xFFFD;
for my $cp437 (grep {$request[$_]->{set} eq 'cp437'} 0 .. $#request) {
my ($len, $class, $name, $title) = @{$def};
my $attr = '';
+ $len /= $nibsize;
$name //= $len <= 2 ? 'res' : 'reserved';
- if (my $part = $offset % 16) {
+ if (my $part = $offset/$nibsize % @nibble) {
# continued row
- my $cols = 16 - $part; # remaining
+ my $cols = @nibble - $part; # remaining
$cols = $len if $len < $cols; #TODO: optimise
if ($len -= $cols) {
# continued on new row
- $table->{$offset + $cols} = [$len, "$class joinu", $name, $title];
+ $table->{$offset + $nibsize*$cols} //= [$len*$nibsize, "$class joinu", $name, $title];
$name = '';
$class .= ' joind';
}
$len = $cols;
}
- elsif (my $rows = $len >> 4) {
+ elsif (my $rows = int($len / @nibble)) {
# multiple full rows
- if ($len -= $rows << 4) {
+ if ($len -= $rows * @nibble) {
# partial row remains
- $table->{$offset + $rows * 16} = [$len, "$class joinu", '', $title];
+ $table->{$offset + $nibsize*$rows * @nibble} //= [$len*$nibsize, "$class joinu", '', $title];
$class .= ' joind';
}
$attr .= sprintf ' rowspan=%d', $rows;
- $len = 16;
+ $len = scalar @nibble;
}
$attr .= sprintf ' colspan=%d', $len unless $len == 1;
+ $attr .= $1 if $class and $class =~ s/( \w+="[^"]*")//;
$attr .= sprintf ' class="%s"', $class if $class;
$attr .= sprintf ' title="%s"', EscapeHTML($title) if $title;
return "<td$attr>$name";
for my $row (@request) {
printf '<div class="section"><table class="glyphs%s">', !$row->{cell} && ' charmap';
- printf '<caption>%s</caption>', $row->{set};
- print '<col>' x 17;
+ my $title = $row->{set};
+ $title .= " <aside>($_)</aside>" for $row->{setnote} // ();
+ printf '<caption>%s</caption>', $title;
+ print '<col>' x (@nibble + 1);
for my $section (qw{thead}) {
print "<$section><tr><th>↱";
print '<th>', $_ for @nibble;
print "\n";
}
print '<tbody>';
- for my $msb (0 .. (length($row->{table}) || 256) - 1 >> 4) {
- printf '<tr><th>%X', $msb + ($row->{offset} >> 4);
+ for my $msb (0 .. ((length($row->{table}) || 256) - 1) / @nibble) {
+ printf '<tr><th>%X', ($msb + int($row->{offset} / @nibble)) * @nibble * $nibsize;
for my $lsb (0 .. $#nibble) {
- my $val = ( ($msb<<4) + $lsb ) * $nibsize;
+ my $val = ( ($msb * @nibble) + $lsb ) * $nibsize;
if ($row->{cell}) {
if (ref $row->{cell} eq 'CODE') {
print $row->{cell}->($val);
}
print "\n";
}
- print "</table></div>\n";
+ say '</table></div>';
}
:>
git.shiar.nl / sheet.git / blobdiff