X-Git-Url: http://git.shiar.nl/sheet.git/blobdiff_plain/bba0d5b6fb0b1bbe6b5bb4a84c72de2152d8dfe3..HEAD:/chars.plp diff --git a/chars.plp b/chars.plp index 96d74b4..91df3b8 100644 --- a/chars.plp +++ b/chars.plp @@ -2,18 +2,27 @@ Html({ title => 'character support sheet', - version => '1.0', + version => '1.2', keywords => [qw' unicode glyph char character reference common ipa symbol sign mark table digraph '], stylesheet => [qw'light dark mono circus red'], - data => [qw( unicode-cover.inc.pl ttfsupport unicode-char.inc.pl )], + data => [qw( data/unicode-cover.inc.pl data/font data/unicode-char.inc.pl )], + raw => <<'EOT', + +EOT }); use Shiar_Sheet::FormatChar; my $glyphs = Shiar_Sheet::FormatChar->new; -my $groupinfo = do 'unicode-cover.inc.pl' or die $@ || $!; +my $groupinfo = Data('data/unicode-cover'); my @ossel = @{ $groupinfo->{osdefault} }; my @fontlist = map { $_->{file} } @@ -21,11 +30,10 @@ my @fontlist = map { $_->{file} } my %font; for my $fontid (@fontlist) { - my ($fontmeta, @fontrange) = do "ttfsupport/$fontid.inc.pl"; - $fontmeta or next; + my $fontmeta = eval { Data("data/font/$fontid") } or next; $font{$fontid} = { (map { (-$_ => $fontmeta->{$_}) } keys %{$fontmeta}), - map { (chr $_ => 1) } @fontrange + map { (chr $_ => 1) } @{ $fontmeta->{cover} } }; } @@ -33,8 +41,7 @@ for my $fontid (@fontlist) { my ($title, $parent) = ('Character overview'); my $query = eval { - for ($ENV{PATH_INFO} || ()) { - s{^/}{}; + for ($Request || ()) { return $_ if m{^[0-9 +-]+$}; my ($cat, $name) = split m{/}, $_, 2 or die "invalid query\n"; @@ -54,8 +61,7 @@ my $query = eval { say "

$title

"; if (!$query) { - say "

Unicode group not specified: $@

"; - exit; + Abort(["Unicode group not found", $@], '404 no matches'); }; for ($parent || 'Unicode range') { @@ -74,15 +80,16 @@ for ($parent || 'Unicode range') { my @chars; for (map { split /[^\d-]/ } $query) { my @range = split /-/, $_, 2; - m/^[0-9]+$/ or die "Invalid code point $_ in query $query\n" for @range; + m/^[0-9]+$/ or Abort("Invalid code point $_ in query $query", 400) + for @range; push @chars, chr $_ for $range[0] .. ($range[1] // $range[0]); } -@chars or die "No match for query $query\n"; +@chars or Abort("No match for query $query", '404 no results'); -@chars <= 1500 or die sprintf( - 'Too many matches (%d) for query %s'."\n", - scalar @chars, $query, +@chars <= 1500 or Abort( + sprintf('Too many matches (%d) for query', scalar @chars), + '403 not allowed', $query ); # output character list @@ -113,7 +120,7 @@ for my $chr (@chars) { my $codepoint = ord $chr; my $ascii = $codepoint <= 127; - print "$chr\n"; + say '', $chr; my $info = $glyphs->glyph_info($codepoint); my ($class, $name, $mnem, $entity, $string) = @$info; print "$_" for sprintf('%X', $codepoint), EscapeHTML($name || '?');