tools/mkdigraphs-rfc

   1 #!/usr/bin/env perl
   2 use 5.010;
   3 use strict;
   4 use warnings;
   5 use utf8;
   6 use open OUT => ':utf8', ':std';
   7
   8 our $VERSION = '1.00';
   9
  10 # translation table for deprecated code points
  11 my %replace = (
  12         0xE001 => 0,  # join lines: not accepted
  13         0xE004 => 0,  # umlaut is no different from diaeresis 0x0308
  14         0xE005 => 0x0344, # discouraged
  15         0xE006 => 0x0300,
  16         0xE007 => 0x0301,
  17         0xE008 => 0x0302,
  18         0xE009 => 0x0303,
  19         0xE00A => 0x0304,
  20         0xE00B => 0x0306,
  21         0xE00C => 0x0307,
  22         0xE00D => 0x0308,
  23         0xE00E => 0x030A,
  24         0xE00F => 0x030B,
  25         0xE010 => 0x030C,
  26         0xE011 => 0x0327,
  27         0xE012 => 0x0328,
  28         0xE013 => 0x0332,
  29         0xE014 => 0x0333,
  30         0xE015 => 0x0338,
  31         0xE016 => 0x0345,
  32         0xE017 => 0x0314,
  33         0xE018 => 0x0313,
  34         0xE019 => 0x1FFE,
  35         0xE01A => 0x1FBF,
  36         0xE01B => 0x03D0,  # middle beta = curled beta?
  37         0xE01C => 0x25CB,
  38         0xE01D => 0x0192,
  39         0xE01E => 0x0292,
  40         0xE01F => 0x33C2,  # am, compatibility char
  41         0xE020 => 0x33D8,  # pm, compatibility char
  42         0xE021 => 0x2121,
  43         0xE022 => 0xFE8E,
  44         0xE023 => 0,  # dutch guilder 0192 is already encoded, and not very useful anyway
  45         0xE024 => 0x0393,
  46         0xE025 => 0x20D7,  # also 20D1; non-spacing
  47         0xE026 => 0x1FEF,
  48         0xE027 => 0x1FC0,
  49         0xE028 => 0x01F0, #but uppercase
  50 );
  51
  52 # expect input data source at command line
  53 @ARGV or die "Specify input source file or - for STDIN\n";
  54
  55 # skip everything until a character indented by 1 space (table start)
  56 do {
  57         $_ = readline;
  58         defined or die "Premature input end";
  59 } until s/^\s(?=\S)//;
  60
  61 chomp;
  62 my @line = $_;  # add first line (already read, assume it's ok)
  63
  64 # read the rest of the character table
  65 while ($_ = readline) {
  66         # check for table end (chapter 4)
  67         last if /^\d/;
  68
  69         # parse table lines (ignore (unindented) page break)
  70         next unless s/^ //;
  71         chomp;
  72
  73         # append line contents
  74         if (s/^ {15}/ /) {
  75                 # continuation line (add to last entry)
  76                 $line[-1] .= $_;
  77         }
  78         else {
  79                 # add a new entry
  80                 push @line, $_;
  81         }
  82 }
  83
  84 # output perl code of hash
  85 # (assume no backslashes or curlies, so we can just q{} w/o escaping)
  86 say "# automatically generated by $0";
  87 say 'use utf8;';
  88 say '+{';
  89 for (@line) {
  90         my ($mnem, $chrhex, $name) = split / +/, $_, 3;
  91         next if length $mnem != 2;
  92         my $chrnum = hex $chrhex;
  93         $chrnum = $replace{$chrnum} or next if defined $replace{$chrnum};
  94         say "q{$mnem}=>$chrnum,";
  95 }
  96 say '}';
  97
  98 __END__
  99
 100 =head1 NAME
 101
 102 mkdigraphs-rfc - Output digraph data from RFC-1345
 103
 104 =head1 SYNOPSIS
 105
 106 Extract digraphs from text specifications as a perl hash:
 107
 108     mkdigraphs-rfc rfc1345.txt >digraphs-rfc.inc.pl
 109
 110 Input can be the literal RFC (or similar) document:
 111
 112     curl http://www.ietf.org/rfc/rfc1345.txt | mkdigraphlist -
 113
 114 Test by printing the character for DO (should be a dollar sign):
 115
 116     perl -e'$di = do "digraphs-rfc.inc.pl"; print chr $di->{DO}'
 117
 118 =head1 DESCRIPTION
 119
 120 Parses the official RFC-1345 document, searching the
 121 'character mnemonic table' for all digraph definitions.
 122 If successful, Perl code is output resulting in a hash
 123 with Unicode code points keyed by digraph.
 124 Obsolete values (references to private use area)
 125 are converted to modern alternatives.
 126 Any errors and warnings are given at STDERR.
 127
 128 =head1 AUTHOR
 129
 130 Mischa POSLAWSKY <perl@shiar.org>
 131
 132 =head1 LICENSE
 133
 134 Licensed under the GNU Affero General Public License version 3.
 135