+++ /dev/null
-#!/usr/bin/env perl
-use 5.010;
-use strict;
-use warnings;
-use utf8;
-
-use open OUT => ':utf8', ':std';
-use Data::Dump 'pp';
-
-our $VERSION = '1.00';
-
-my %info = (
- "\xAD" => {string => '-'},
- "\x{200E}" => {string => '→'},
- "\x{200F}" => {string => '←'},
-);
-$info{chr $_} //= {} for 32 .. 126;
-
-eval {
- my $tables = do 'unicode-table.inc.pl' or die $@ || $!;
- for (values %$tables) {
- for (values %$_) {
- for (@$_) {
- length $_ == 1 or next; # ignore meta values
- s/\\//; # unescape
- $info{$_} //= {};
- }
- }
- }
- 1;
-} or warn "Failed reading unicode tables: $@";
-
-eval {
- require HTML::Entities;
- while (my ($char, $entity) = each %HTML::Entities::char2entity) {
- $entity =~ /[a-zA-Z]/ or next; # only actual aliases
- $info{$char}->{html} = substr($entity, 1, -1);
- }
- 1;
-} or warn "Failed importing html entities: $@";
-
-my %diinc = (
- 'digraphs.inc.pl' => 'u-di',
-);
-for (keys %diinc) {
- -e $_ or next;
- my $di = do $_ or die "Error reading digraphs file $_: ", $@ || $!;
- while (my ($mnem, $cp) = each %$di) {
- length $mnem == 2 or next; # limit to digraphs
- my $class = $diinc{$_};
- if (ref $cp) {
- # old style array
- $class = 'u-prop' if $cp->[2] and $cp->[2] =~ m/\bXz\b/;
- $cp = chr $cp->[0];
- }
- $info{$cp}->{di} //= $mnem;
- $info{$cp}->{class}->{$class}++;
- }
-}
-
-for my $chr (keys %info) {
- my $cp = ord $chr;
- # attempt to get unicode character information
- my $info = eval {
- require Unicode::UCD;
- Unicode::UCD::charinfo($cp)
- || { block => '?', category => 'Xn', name => '', script => '' }
- } or next;
-
- $info->{$_} = $info{$chr}->{$_} for qw(di html class string);
-
- # categorise by unicode types and writing script
- $info->{class}->{$_}++ for $info->{category};
- $info->{class}->{$_}++ for $info->{script} || ();
-
- # add custom categories for certain blocks
- $info->{class}->{Xa}++ if $info->{block} eq 'Basic Latin';
- $info->{class}->{Xl}++ if $info->{block} eq 'Latin-1 Supplement';
-
- given ($cp) {
- when ($info->{string}) {
- # keep predefined presentational string
- }
- when ($info->{combining}) {
- # overlay combining accents
- $info->{string} = chr(9676) . $chr;
- }
- when (($cp & ~0b1001_1111) == 0 or $cp == 127) {
- # control characters (first 32 chars from 0 and 128)
- # rename to something more descriptive
- $info->{name} = $info->{unicode10}
- ? '<'.$info->{unicode10}.'>' # the old name was much more useful
- : sprintf('<control U+%04X>', $cp); # at least identify by value
- # show descriptive symbols instead of control chars themselves
- $info->{string} = $cp < 32 ? chr($cp + 0x2400) : chr(0xFFFD);
- }
- }
-
- $info{$chr} = $info;
-}
-
-# output perl code of hash
-say 'use utf8;';
-say '+{';
-for my $cp (sort keys %info) {
- $info{$cp}->{classstr} = join(' ', sort keys %{ $info{$cp}->{class} });
- # convert info hashes into arrays of strings to output in display order
- my $row = [ map { $info{$cp}->{$_} } qw/classstr name di html string/ ];
- # strip off trailing missing values (especially string may be unknown)
- defined $row->[-1] ? last : pop @$row for 1 .. @$row;
- # final line (assume safe within single quotes)
- say sprintf '"\x{%X}" => [%s],',
- ord $cp, join(',', map { escapeq($_) } @$row);
-}
-say '}';
-
-sub escapeq {
- my $_ = shift;
- return 'undef' if not defined;
- s/(['\\])/\\$1/g;
- return "'$_'";
-}
-
-__END__
-
-=head1 NAME
-
-convert-unicode.pl - Gather Unicode character details in Perl array
-
-=head1 SYNOPSIS
-
- convert-unicode > unicode-char.inc.pl
-
-Test by printing the description of U+0041 (latin A):
-
- perl -e'$u = do "unicode-char.inc.pl"; print $u->{A}->[1]'
-
-=head1 AUTHOR
-
-Mischa POSLAWSKY <perl@shiar.org>
-
-=head1 LICENSE
-
-Licensed under the GNU Affero General Public License version 3.
-
git.shiar.nl / sheet.git / blobdiff