7 use open OUT => ':utf8', ':std';
10 our $VERSION = '1.03';
12 # create a hash of desired input
13 my $di = do 'data/digraphs-rfc.inc.pl'
14 or die "error reading digraphs include: ", $@ // $!;
17 my $extra = do 'data/digraphs-shiar.inc.pl'
18 or warn "could not include shiar proposals: ", $@ // $!;
19 $di = { %{$di}, %{$extra // {}} };
21 $di->{chr $_} = $_ for 32 .. 126;
22 $di->{'\\'.$_} = delete $di->{$_} for '{', '}', '\\';
24 # optionally get unicode character information
28 $_ => Unicode::UCD::charinfo($di->{$_})
29 || { block => '?', category => 'Xn', name => '', script => '' }
33 # add custom categories for certain blocks
35 $_->{category} .= ' Xa' if $_->{block} eq 'Basic Latin';
36 $_->{category} .= ' Xl' if $_->{block} eq 'Latin-1 Supplement';
39 # mark unofficial extras as such
40 $info{$_}->{category} .= ' Xz' for keys %{$extra};
43 $info{$_}->{string} = chr(9676) . chr($di->{$_}) if $info{$_}->{combining};
44 # find control characters (first 32 chars from 0 and 128)
45 next unless ($di->{$_} & ~0b1001_1111) == 0 or $di->{$_} == 127;
46 # rename to something more descriptive
47 $info{$_}->{name} = $info{$_}->{unicode10}
48 ? '<'.$info{$_}->{unicode10}.'>' # the old name was much more useful
49 : sprintf('<control U+%04X>', $di->{$_}); # at least identify by value
50 # show descriptive symbols instead of control chars themselves
51 $info{$_}->{string} = $di->{$_} < 32 ? chr($di->{$_} + 0x2400) : chr(0xFFFD);
53 # presentational string for some control(lish) entries
54 $info{$_}->{string} = '-' for grep { $di->{$_} == 0x00AD } keys %{$di};
55 $info{$_}->{string} = '␣' for grep { $di->{$_} == 0x200B } keys %{$di};
56 $info{$_}->{string} = '|' for grep { $di->{$_} == 0x200C } keys %{$di};
57 $info{$_}->{string} = '⁀' for grep { $di->{$_} == 0x200D } keys %{$di};
58 $info{$_}->{string} = '→' for grep { $di->{$_} == 0x200E } keys %{$di};
59 $info{$_}->{string} = '←' for grep { $di->{$_} == 0x200F } keys %{$di};
61 # convert info hashes into arrays of strings to output in display order
62 for my $row (values %info) {
63 $row = [ map { $row->{$_} } qw/name category script string/ ];
64 # strip off trailing missing values (especially string may be unknown)
65 defined $row->[-1] ? last : pop @$row for 1 .. @$row;
68 # output perl code of hash
69 # (assume no backslashes or curlies, so we can just q{} w/o escaping)
70 print "# automatically generated by $0\n";
73 printf '(map {$_=>0} qw{%s}),'."\n", join(' ',
74 map { substr($_, 1, 1).substr($_, 0, 1) } sort keys %{$di}
76 printf "q{%s}=>[%s],\n", $_, join(',',
77 $di->{$_}, # original code point
78 $info{$_} # optional additional arguments
79 ? map {"'$_'"} @{ $info{$_} }
81 ) for sort keys %{$di};
88 mkdigraphlist - Output character list of combined digraph data
92 mkdigraphlist >digraphs.inc.pl
93 perl -e'$di = do "digraphs.inc.pl"; print chr $di->{DO}->[0]'
97 Parses the official RFC-1345 document, searching the
98 'character mnemonic table' for all digraph definitions.
99 If successful, Perl code is output resulting in a hash
100 with character data keyed by digraph.
101 Any errors and warnings are given at STDERR.
103 The value can either be a scalar string containing another
104 digraph which can be considered identical (usually inverted),
105 or an array ref containing at least the resulting character's
106 Unicode code point value. If available, the following UCD data
107 is appended: character name, category, script, and output string.
111 AE => [198, 'LATIN CAPITAL LETTER AE', 'Lu Xl', 'Latin'],
117 Mischa POSLAWSKY <perl@shiar.org>
121 Licensed under the GNU Affero General Public License version 3.