7.1/src/add-other-spellings

   1 #!/usr/bin/perl
   2
   3 while(<STDIN>) {
   4     chop;
   5     $words{$_} = '';
   6     $know_about{$_} = 1;
   7 }
   8
   9 sub valid_entry ( $ ){local $_ = $_[0]; /^[A-Za-z\']+$/ && exists $words{$_}}
  10
  11 foreach my $f (qw(working/variant_0.lst working/variant_1.lst
  12                   working/variant_2.lst
  13                   working/british_variant_0.lst working/british_variant_1.lst
  14                   working/canadian_variant_0.lst working/canadian_variant_1.lst
  15                   working/american.lst
  16                   working/british.lst working/british_z.lst
  17                   working/canadian.lst))
  18 {
  19     open F, $f or die "Unable to open $f\n";
  20     while (<F>) {
  21         chop;
  22         $know_about{$_} = 1;
  23     }
  24 }
  25
  26 open F, "r/varcon/voc.tab" or die;
  27
  28 while (<F>) {
  29     s/\(.+\)\n/\n/;
  30     my ($word) = grep {valid_entry $_} (split /[,\t\n]/);
  31     next unless defined $word;
  32     y/,\t -/\n/;
  33     s/(^|\n)\n/\n/g;
  34     $words{$word} .= $_;
  35 }
  36
  37 open F, "r/varcon/variant.tab" or die;
  38
  39 while (<F>) {
  40     @w = grep {$know_about{$_}} (split /[\t\n]/);
  41     next unless @w && grep {valid_entry $_} @w;
  42     $words{$w[0]} .= "$_\n" foreach @w;
  43 }
  44
  45 open F, "r/varcon/variant-wroot.tab" or die;
  46
  47 while (<F>) {
  48     s/^(.+)\:\t// or die;
  49     my $root = $1;
  50     next unless exists $words{$root};
  51     @w = grep {$know_about{$_}} (split /[\t\n]/);
  52     next unless @w && grep {valid_entry $_} @w;
  53     $words{$w[0]} .= "$_\n" foreach @w;
  54 }
  55
  56 while (($key, $value) = each %words) {
  57     print "$key\n$value";
  58 }