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/american.lst
  18                   working/british.lst working/british_z.lst
  19                   working/canadian.lst))
  20 {
  21     open F, $f or die "Unable to open $f\n";
  22     while (<F>) {
  23         chop;
  24         $know_about{$_} = 1;
  25     }
  26 }
  27
  28 if (not $table) {
  29     open F, "r/varcon/voc.tab" or die;
  30
  31     while (<F>) {
  32         s/\(.+\)\n/\n/;
  33         my ($word) = grep {valid_entry $_} (split /[,\t\n]/);
  34         next unless defined $word;
  35         y/,\t -/\n/;
  36         s/(^|\n)\n/\n/g;
  37         $words{$word} .= $_;
  38     }
  39 }
  40
  41 open F, "r/varcon/variant.tab" or die;
  42
  43 while (<F>) {
  44     @w = grep {$know_about{$_}} (split /[\t\n]/);
  45     next unless @w && grep {valid_entry $_} @w;
  46     $words{$w[0]} .= "$_\n" foreach @w;
  47 }
  48
  49 open F, "r/varcon/variant-wroot.tab" or die;
  50
  51 while (<F>) {
  52     s/^(.+)\:\t// or die;
  53     my $root = $1;
  54     next unless exists $words{$root};
  55     @w = grep {$know_about{$_}} (split /[\t\n]/);
  56     next unless @w && grep {valid_entry $_} @w;
  57     $words{$w[0]} .= "$_\n" foreach @w;
  58 }
  59
  60 if ($table) {
  61
  62     while (($key, $value) = each %words) {
  63         next if $value eq '';
  64         my $row = "$key\n$value";
  65         chomp $row;
  66         $row =~ tr/\n/\t/;
  67         print "$row\n";
  68     }
  69
  70 } else {
  71
  72     while (($key, $value) = each %words) {
  73         print "$key\n$value";
  74     }
  75
  76 }