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/;
  60
  61 my @line = $_;  # add first line (already read, assume it's ok)
  62
  63 # read the rest of the character table
  64 while ($_ = readline) {
  65         # check for table end (chapter 4)
  66         last if /^\d/;
  67
  68         # parse table lines (ignore (unindented) page break)
  69         next unless s/^ //;
  70         chomp;
  71
  72         # append line contents
  73         if (s/^ {15}/ /) {
  74                 # continuation line (add to last entry)
  75                 $line[-1] .= $_;
  76         }
  77         else {
  78                 # add a new entry
  79                 push @line, $_;
  80         }
  81 }
  82
  83 # output perl code of hash
  84 # (assume no backslashes or curlies, so we can just q{} w/o escaping)
  85 say "# automatically generated by $0";
  86 say 'use utf8;';
  87 say '+{';
  88 for (@line) {
  89         my ($mnem, $chrhex, $name) = split / +/, $_, 3;
  90         next if length $mnem != 2;
  91         my $chrnum = hex $chrhex;
  92         $chrnum = $replace{$chrnum} or next if defined $replace{$chrnum};
  93         say "q{$mnem}=>$chrnum,";
  94 }
  95 say '}';
  96
  97 __END__
  98
  99 =head1 NAME
 100
 101 mkdigraphs-rfc - Output digraph data from RFC-1345
 102
 103 =head1 SYNOPSIS
 104
 105 Extract digraphs from text specifications as a perl hash:
 106
 107     mkdigraphs-rfc rfc1345.txt >digraphs-rfc.inc.pl
 108
 109 Input can be the literal RFC (or similar) document:
 110
 111     curl http://www.ietf.org/rfc/rfc1345.txt | mkdigraphlist -
 112
 113 Test by printing the character for DO (should be a dollar sign):
 114
 115     perl -e'$di = do "digraphs-rfc.inc.pl"; print chr $di->{DO}'
 116
 117 =head1 DESCRIPTION
 118
 119 Parses the official RFC-1345 document, searching the
 120 'character mnemonic table' for all digraph definitions.
 121 If successful, Perl code is output resulting in a hash
 122 with Unicode code points keyed by digraph.
 123 Obsolete values (references to private use area)
 124 are converted to modern alternatives.
 125 Any errors and warnings are given at STDERR.
 126
 127 =head1 AUTHOR
 128
 129 Mischa POSLAWSKY <perl@shiar.org>
 130
 131 =head1 LICENSE
 132
 133 Licensed under the GNU Affero General Public License version 3.
 134