rfc1345convert

   1 #!/usr/bin/env perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Data::Dumper;
   7
   8 our $VERSION = '1.00';
   9
  10 if (0) {
  11         #TODO: automatic download if not specified on stdin
  12         require LWP::Simple;
  13         LWP::Simple::get('http://www.ietf.org/rfc/rfc1345.txt');
  14 }
  15
  16 # skip everything until a character indented by 1 space (table start)
  17 do {$_ = <>} until /^\s\S/;
  18
  19 my @t = $_;  # add first line (already read, assume it's ok)
  20
  21 # read the rest of the character table
  22 while ($_ = <>) {
  23         # check for table end (chapter 4)
  24         last if /^4/;
  25
  26         # parse table lines (ignore (unindented) page break)
  27         next unless s/^ //;
  28         chomp;
  29
  30         # add the line to @t
  31         if (s/^ {15}/ /) {
  32                 # continuation line (add to last entry)
  33                 $t[-1] .= $_;
  34         }
  35         else {
  36                 # add a new entry
  37                 push @t, $_;
  38         }
  39 }
  40
  41 # create a hash of desired input
  42 my %di;
  43 for (@t) {
  44         my ($mnem, $char, $name) = split / +/, $_, 3;
  45         next if length $mnem != 2;
  46         $di{$mnem} = hex $char;
  47 }
  48
  49 # optionally get unicode character information
  50 my %info = eval {
  51         require Unicode::UCD;
  52         map { $_ => Unicode::UCD::charinfo($di{$_}) } keys %di;
  53 };
  54
  55 # add custom categories for certain blocks
  56 for (values %info) {
  57         $_->{category} .= ' Xa' if $_->{block} eq 'Basic Latin';
  58         $_->{category} .= ' Xl' if $_->{block} eq 'Latin-1 Supplement';
  59 }
  60
  61 # output perl code of hash
  62 # (assume no backslashes or curlies, so we can just q{} w/o escaping)
  63 print "{\n";
  64 printf "q{%s}=>[%s],\n", $_, join(',',
  65         $di{$_},       # glyph code point
  66         $info{$_}  # optional additional arguments
  67                 ? map {"'$_'"} @{ $info{$_} }{qw/name category script/}
  68                 : ()
  69 ) for sort keys %di;
  70 print "}\n";
  71