+#!/usr/bin/perl
+
+my $table = $ARGV[0] eq 'table' ? '1' : '0';
+
+while(<STDIN>) {
+ chop;
+ $words{$_} = '';
+ $know_about{$_} = 1;
+}
+
+sub valid_entry ( $ ){local $_ = $_[0]; /^[A-Za-z\']+$/ && exists $words{$_}}
+
+foreach my $f (qw(working/variant_1.lst working/variant_2.lst
+ working/variant_3.lst
+ working/british_variant_1.lst working/british_variant_2.lst
+ working/canadian_variant_1.lst working/canadian_variant_2.lst
+ working/american.lst
+ working/british.lst working/british_z.lst
+ working/canadian.lst))
+{
+ open F, $f or die "Unable to open $f\n";
+ while (<F>) {
+ chop;
+ $know_about{$_} = 1;
+ }
+}
+
+if (not $table) {
+ open F, "r/varcon/voc.tab" or die;
+
+ while (<F>) {
+ s/\(.+\)\n/\n/;
+ my ($word) = grep {valid_entry $_} (split /[,\t\n]/);
+ next unless defined $word;
+ y/,\t -/\n/;
+ s/(^|\n)\n/\n/g;
+ $words{$word} .= $_;
+ }
+}
+
+open F, "r/varcon/variant.tab" or die;
+
+while (<F>) {
+ @w = grep {$know_about{$_}} (split /[\t\n]/);
+ next unless @w && grep {valid_entry $_} @w;
+ $words{$w[0]} .= "$_\n" foreach @w;
+}
+
+open F, "r/varcon/variant-wroot.tab" or die;
+
+while (<F>) {
+ s/^(.+)\:\t// or die;
+ my $root = $1;
+ next unless exists $words{$root};
+ @w = grep {$know_about{$_}} (split /[\t\n]/);
+ next unless @w && grep {valid_entry $_} @w;
+ $words{$w[0]} .= "$_\n" foreach @w;
+}
+
+if ($table) {
+
+ while (($key, $value) = each %words) {
+ next if $value eq '';
+ my $row = "$key\n$value";
+ chomp $row;
+ $row =~ tr/\n/\t/;
+ print "$row\n";
+ }
+
+} else {
+
+ while (($key, $value) = each %words) {
+ print "$key\n$value";
+ }
+
+}