tools/mkdigraphlist

   1 #!/usr/bin/env perl
   2
   3 use strict;
   4 use warnings;
   5 use utf8;
   6
   7 use open OUT => ':utf8', ':std';
   8 use Data::Dumper;
   9
  10 our $VERSION = '1.03';
  11
  12 # create a hash of desired input
  13 my $di = do 'data/digraphs-rfc.inc.pl'
  14         or die "error reading digraphs include: ", $@ // $!;
  15
  16 # personal addendums
  17 my $extra = do 'data/digraphs-shiar.inc.pl'
  18         or warn "could not include shiar proposals: ", $@ // $!;
  19 $di = { %{$di}, %{$extra // {}} };
  20
  21 $di->{chr $_} = $_ for 32 .. 126;
  22 $di->{'\\'.$_} = delete $di->{$_} for '{', '}', '\\';
  23
  24 # optionally get unicode character information
  25 my %info = eval {
  26         require Unicode::UCD;
  27         map {
  28                 $_ => Unicode::UCD::charinfo($di->{$_})
  29                         || { block => '?', category => 'Xn', name => '', script => '' }
  30         } keys %{$di};
  31 };
  32
  33 # add custom categories for certain blocks
  34 for (values %info) {
  35         $_->{category} .= ' Xa' if $_->{block} eq 'Basic Latin';
  36         $_->{category} .= ' Xl' if $_->{block} eq 'Latin-1 Supplement';
  37 }
  38
  39 # mark unofficial extras as such
  40 $info{$_}->{category} .= ' Xz' for keys %{$extra};
  41
  42 for (keys %{$di}) {
  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);
  52 }
  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};
  60
  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;
  66 }
  67
  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";
  71 print "use utf8;\n";
  72 print "+{\n";
  73 printf '(map {$_=>0} qw{%s}),'."\n", join(' ',
  74         map { substr($_, 1, 1).substr($_, 0, 1) } sort keys %{$di}
  75 );
  76 printf "q{%s}=>[%s],\n", $_, join(',',
  77         $di->{$_},   # original code point
  78         $info{$_}  # optional additional arguments
  79                 ? map {"'$_'"} @{ $info{$_} }
  80                 : ()
  81 ) for sort keys %{$di};
  82 print "}\n";
  83
  84 __END__
  85
  86 =head1 NAME
  87
  88 mkdigraphlist - Output character list of combined digraph data
  89
  90 =head1 SYNOPSIS
  91
  92     mkdigraphlist >digraphs.inc.pl
  93     perl -e'$di = do "digraphs.inc.pl"; print chr $di->{DO}->[0]'
  94
  95 =head1 DESCRIPTION
  96
  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.
 102
 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.
 108 For example:
 109
 110  +{
 111    AE => [198, 'LATIN CAPITAL LETTER AE', 'Lu Xl', 'Latin'],
 112    EA => 'AE',
 113   }
 114
 115 =head1 AUTHOR
 116
 117 Mischa POSLAWSKY <perl@shiar.org>
 118
 119 =head1 LICENSE
 120
 121 Licensed under the GNU Affero General Public License version 3.
 122