src/add-other-spellings

   1 #!/usr/bin/perl
   2
   3 my $table = $ARGV[0] eq 'table' ? '1' : '0';
   4
   5 while(<STDIN>) {
   6     chop;
   7     $words{$_} = '';
   8     $know_about{$_} = 1;
   9 }
  10
  11 sub valid_entry ( $ ){local $_ = $_[0]; /^[A-Za-z\']+$/ && exists $words{$_}}
  12
  13 foreach my $f (qw(working/variant_1.lst working/variant_2.lst
  14                   working/variant_3.lst
  15                   working/british_variant_1.lst working/british_variant_2.lst
  16                   working/canadian_variant_1.lst working/canadian_variant_2.lst
  17                   working/australian_variant_1.lst working/australian_variant_2.lst
  18                   working/american.lst
  19                   working/british.lst working/british_z.lst
  20                   working/canadian.lst working/australian.lst))
  21 {
  22     open F, $f or die "Unable to open $f\n";
  23     while (<F>) {
  24         chop;
  25         $know_about{$_} = 1;
  26     }
  27 }
  28
  29 if (not $table) {
  30     open F, "r/varcon/voc.tab" or die;
  31
  32     while (<F>) {
  33         s/\(.+\)\n/\n/;
  34         my ($word) = grep {valid_entry $_} (split /[,\t\n]/);
  35         next unless defined $word;
  36         y/,\t -/\n/;
  37         s/(^|\n)\n/\n/g;
  38         $words{$word} .= $_;
  39     }
  40 }
  41
  42 open F, "r/varcon/variant.tab" or die;
  43
  44 while (<F>) {
  45     @w = grep {$know_about{$_}} (split /[\t\n]/);
  46     next unless @w && grep {valid_entry $_} @w;
  47     $words{$w[0]} .= "$_\n" foreach @w;
  48 }
  49
  50 open F, "r/varcon/variant-wroot.tab" or die;
  51
  52 while (<F>) {
  53     s/^(.+)\:\t// or die;
  54     my $root = $1;
  55     next unless exists $words{$root};
  56     @w = grep {$know_about{$_}} (split /[\t\n]/);
  57     next unless @w && grep {valid_entry $_} @w;
  58     $words{$w[0]} .= "$_\n" foreach @w;
  59 }
  60
  61 if ($table) {
  62
  63     while (($key, $value) = each %words) {
  64         next if $value eq '';
  65         my $row = "$key\n$value";
  66         chomp $row;
  67         $row =~ tr/\n/\t/;
  68         print "$row\n";
  69     }
  70
  71 } else {
  72
  73     while (($key, $value) = each %words) {
  74         print "$key\n$value";
  75     }
  76
  77 }