#!/usr/bin/perl

use strict;
use warnings;
use IO::Handle;

use varcon qw(%map);

$varcon::MAX_VARIANT_LEVEL = 3;

my %F;

my %lists_pre;

# $cat = 'normal' or 'uncommon'
# $sp = spelling
# $vl = variant_level

my $file = $ARGV[0];
$file = "varcon.txt" unless defined $file;

open F, $file;    
while (<F>) {
    #print;
    next if varcon::filter $_;
    my %notes;
    my %r = varcon::flatten(varcon::readline($_,\%notes));
    my $cat = $notes{uncommon} ? 'uncommon' : 'normal';
    #if ($cat eq 'uncommon') {
    #    print "UNCOMMON: $_\n";
    #}
    foreach my $k (sort keys %r) {
        #print ">>$k<<\n";
        my ($sp, $vl) = $k =~ /^(.)(.)?$/ or die "Bad: $k";
        $vl = ' ' unless defined $vl;
        foreach my $word (@{$r{$k}}) {
            $lists_pre{$sp}{$vl}{$cat}{$word}++;
        }
    }
}

my %lists;

my %sp_tally;
my $sp_count = 0;
foreach my $sp (sort keys %lists_pre) {
    next if $sp eq '_';
    $sp_count++;
    foreach my $cat ('normal', 'uncommon') {
        foreach my $word (keys %{$lists_pre{$sp}{' '}{$cat}}) {
            $sp_tally{$cat}{$word}++;
        }
    }
}
sub in_all_sps($$$$) {
    my ($sp,$vl,$cat,$word) = @_;
    return 0 if $sp eq '_' || $vl ne ' ';
    return defined $sp_tally{$cat}{$word} && $sp_tally{$cat}{$word} == 4;
}

foreach my $cat ('normal', 'uncommon') {
    foreach my $word (sort keys %{$sp_tally{$cat}}) {
        next unless (defined $sp_tally{$cat}{$word} 
                     && $sp_tally{$cat}{$word} == 4);
        push @{$lists{"Q- -$cat"}}, $word;
    }
}

my $cat = 'normal';
foreach my $sp (sort keys %lists_pre) {
    my %already_have;
    foreach my $vl (sort keys %{$lists_pre{$sp}}) {
        foreach my $word (keys %{$lists_pre{$sp}{$vl}{$cat}}) {
            next if $already_have{$word};
            $already_have{$word}++;
            next if in_all_sps($sp,$vl,$cat,$word);
            push @{$lists{"$sp-$vl-$cat"}}, $word;
        }
    }
}

foreach my $sp (sort keys %lists_pre) {
    my %already_have;
    foreach my $vl (sort keys %{$lists_pre{$sp}}) {
        foreach my $cat ('normal', 'uncommon') {
            foreach my $word (keys %{$lists_pre{$sp}{$vl}{$cat}}) {
                next if $already_have{$word};
                $already_have{$word}++;
                next if in_all_sps($sp,$vl,$cat,$word);
                push @{$lists{"$sp-$vl-$cat"}}, $word if $cat eq 'uncommon';
            }
        }
    }
}

foreach my $k (sort keys %lists) {
    my ($sp, $vl, $cat) = split '-', $k;
    my $name = $sp eq 'Q' ? 'common' : $map{$sp};
    $name .= "-v$vl" if $vl ne ' ';
    $name .= "-uncommon" if $cat eq 'uncommon';
    $name .= ".lst";
    my @words = sort @{$lists{$k}};
    open F, ">$name";
    my $prev = '';
    foreach (@words) {
        next if $_ eq $prev;
        $prev = $_;
        print F "$_\n";
    }
}

